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1.  INTRODUCTION  AND  OVERVIEW 


DELFIC  (DE tense  Land  Fallout  interpretative  Code)  is  intended  for  re¬ 
search  in  local  nuclear  fallout  prediction  and  to  serve  as  a  standard 
against  which  predictions  by  less  capable,  production-oriented  codes  can 
be  judged.  By  local  fallout  we  mean  the  intensely  radioactive  material 
which  falls  to  the  ground  within  several  to  several  hundred  miles  of 
ground  zero,  depending  on  the  size  of  the  explosion.  The  code  is  essen¬ 
tially  open-ended  with  regard  to  input  data,  it  is  highly  flexible  in  that 
it  offers  many  options  that  would  not  be  available  in  a  production- 
oriented  code,  and  it  strives  to  include  as  much  of  the  physics  of  fallout 
transport  and  activity  calculation,  without  resorting  to  short  cuts,  as  is 
practicabl e. 

Calculation  begins  at  about  the  time  the  fireball  reaches  pressure 
equilibrium  with  the  atmosphere.  Rise,  growth  and  stabilization  of  the 
nuclear  cloud  is  computed  by  a  dynamic  model  that  treats  the  cloud  as  an 
entraining  bubble  of  hot  air  loaded  with  water  and  contaminated  ground 
material.  The  fallout  particle  cloud,  including  the  stem,  is  formed  during 
the  cloud  rise.  This  calculation  requires  specification  of  a  vertical  pro¬ 
file  of  atmospheric  data:  pressure,  temperature,  humidity  and  wind;  thus 
the  height,  dimensions  and  vertically  sheared  horizontal  displacement  of  a 
particular  cloud  are  determined  by  the  atmospheric  stability  and  winds. 

After  cloud  stabilization,  representative  parcels  of  fallout  are  trans¬ 
ported  through  an  atmosphere  that  is  defined  by  input  data.  The  user  may 
specify  a  single  vertical  wind  profile  and  assume  a  steady  state.  He  may 
specify  any  number  of  wind  profile  updates.  He  may  resolve  the  transport 
space  in  the  horizontal  and  specify  multiple  wind  profiles  defined  at  dif¬ 
ferent  geographical  locations,  in  which  case  winds  in  the  cells  of  a  three- 
dimensional  space  grid  are  determined  by  an  interpolation  procedure. 
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During  transport,  fallout  parcels  are  expanded  in  the  horizontal  by 
ambient  turbulence.  Turbulence  data  may  be  input  along  with  the  winds, 
but  since  these  data  are  rarely  available,  they  can  be  calculated  by  the 
code. 

To  account  for  effects  of  vertical  wind  shear  on  the  dispersion  of 
individual  parcels,  tops  and  bases  of  the  parcels  are  transported  to  ground 
impaction  separately,  and  then  recombined.  The  impacted  parcels  are  dis¬ 
tributed  over  the  ground  via  a  bivariate  Gaussian  function. 

Any  or  all  of  sixteen  unique  quantities  computed  from  the  deposited 
fallout  may  be  mapped.  Radioactivity  is  calculated  rigorously  for  any  time 
by  summing  exposure  or  exposure  rate  contributions  from  all  nuclides  in  the 
mixture  of  fission  products.  Any  of  twelve  different  types  of  fission  may 
be  specified.  Induced  activity  in  soil  material  in  the  fallout  and  in  238U 
may  be  accounted  for. 

Physical  and  mathematical  bases  for  DELFIC  are  given  in  Volume  I  of 
this  set. 


6 


2.  CODE  DESCRIPTION 


2.1  STRUCTURE 

DELFIC  is  a  FORTRAN  code  in  three  major  parts  or  modules: 

1.  Initialization  and  Cloud  Rise  Module  (ICRM) 

2.  Diffusive  Transport  Module  (DTM) 

3.  Output  Processor  Module  (0PM),  plus  the  Particle  Activity  Sub- 
modules  which  are  controlled  by  tne  0PM. 

The  ICRM  accepts  basic  data  and  carries  the  prediction  calculation  through 
rise  and  stabilization  of  the  nuclear  cloud.  The  DTM  transports  fallout 
parcels  from  the  stabilized  cloud  to  ground  impaction,  and  the  0PM  processes 
the  deposited  parcels  into  fallout  map:.. 

Communication  between  modules  is  via  external  storage  units  (Table  1) 
jo  that  the  modules  can  and  should  be  overlayed.  COMMON  NUMTAP(15),  which 
appears  in  each  overlay  executive  program,  contains  external  storage  unit 
numbers.  Figure  1  displays  the  code  organization  including  the  overlay 
structure. 

Table  2  provides  an  alphabetical  listing  of  all  DELFIC  programs  with  a 
description  of  the  function  of  each.  FORTRAN  codes  are  listed  in  sec.  5. 

The  executive  code  (ICRMEX,  DTMEX,  OPMEX)  of  each  module  contains  extensive 
glossaries  of  mnemonics. 


2.2  COMPUTER  REQUIREMENTS 

This  version  of  DELFIC  operates  on  the  CDC  6600  computer  with  the  over¬ 
lay  structure  given  in  Fig.  1.  The  amount  of  central  memory  storage  required 
depends  on  the  demands  of  the  problem.  Variable  dimensioned  arrays  are  used 
(sec.  2.3).  For  the  example  problem  (sec.  4),  which  uses  array  dimensions 
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TABLE  1 


EXTERNAL  STORAGE  UNITS  USED  BY  DELFIC 


NUMTAP(I) 
Index,  I 

Symbolic 

Name 

Module 

Use 

1 

ISIN 

I  CRM 

DTM 

OPM 

System  unit  for  card  input. 

2 

ISOUT 

KOUT 

I  CRM 

DTM 

OPM 

System  unit  for  printing. 

3 

IRISE 

I  CRM 

Temporary  storage  during  atmospheric 
stability  data  processing  (Subroutine 
ATMR),  and  storage  of  basic  data  and 
fallout  parcel  descriptions  in  the 
stabilized  cloud  before  correction  of 
horizontal  positions  for  advective 
transport  during  cloud  rise.  (Sub¬ 
routines  RSXP  and  WNDSFT). 

I  POUT 

DTM 

Output  of  basic  data  and  fallout  de¬ 
posit  increment  (i.e.,  grounded  parcel) 
descriptions  fror,.  the  DTM.  (Subroutines 
DTM I NT  ,  DUMPER  ano  SPRVS). 

I  POUT 

KPOUT 

KTAPE 

OPM 

Input  of  basic  data  and  fallout  deposit 
increment  descriptions  to  the  OPM. 
(Subroutines  0PM1,  0PM2,  GOGO). 

4 

JPARN 

I  CRM 

Output  of  basic  data  and  fallout  parcel 
descriptions  in  the  stabilized  cloud 
after  correction  of  horizontal  positions 
for  advective  transport  during  cloud  rise. 
(Subroutine  WNDSFT). 

JPARN 

DTM 

Input  of  basic  data  and  fallout  parcel 
descriptions  to  the  DTM.  (Subroutines 

DTM I NT  and  SPRVS). 

5 

JPOUT 

KTAPE 

LTAPE 

OPM 

Temporary  storage  of  fallout  deposit 
increment  descriptions  for  maps  that  re¬ 
quire  storage  in  excess  of  the  OMAP  array 
capacity.  (Subroutines  0PM2,  GOGO  and 
PDMP) . 
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TABLE  1  (con't.) 


NUMTAP(I) 
Index,  I 

Symbol ic 
Name 

Modul e 

Use 

6 

KPOUT 

KTAPE 

LTAPE 

0PM 

Temporary  storage  of  fallout  deposit 
increment  descriptions  for  maps  that  re¬ 
quire  storage  in  excess  of  the  OMAP  array 
capacity.  (Subroutines  0PM2,  GOGO  and 
PDMP). 

7 

IPNCH 

0PM 

System  unit  for  card  punch.  (Subroutine 
SRTCNT). 

8 

MBTAPE 

0  PM 

Multiburst  output  tape.  Not  currently 
used.  (Subroutine  MAP). 

9 

IN  PAM 

INTP 

0  PM 

Fission  yield  data  used  for  activity 
calculation  (PAM1). 

! 


MAIN  TRPL 
Overlay  0,0  —  ERROR 
COMMON  NilMTAP f  1 5)  SETH 


TABLE  2 


ALPHABETICAL  LIST  AND  DESCRIPTION  OF  PROGRAMS 


Program 

Module 

Called 

By 

Description 

ADVEC 

DTM 

SPRVS 

For  each  fallout  parcel:  calls  TRANP  to  transport  top 
and  base  separately  from  stabilized  cloud  to  ground  im¬ 
pact,  and  recombines  impacted  top  and  base  to  form  a 
single  deposit  increment  of  fallout. 

AIRBRS 

ICRM 

I  CM 

For  a  pure  airburst:  sets  particle  size  distribution 
parameters,  and  sets  time,  temperature  and  mass  of  debris 

contained  in  the  initial  cloud. 

ATMR 

I  CRM 

I  CM 

Inputs  and  processes  atmospheric  stability  and  humidity 
data  (altitude,  temperature,  pressure,  relative  humidity, 
and  optionally,  density  and  viscosity). 

BATMAN 

OPM 

FRATIO 

GXPSR 

MCHDEP 

Computes  activity  decay  chains  by  means  of  the  Bateman 
equation  (I,  eq.  (4.2.1)). 

BOUN 

DTM 

TRANP 

Calculates  horizontal  coordinates  of  the  point  of  en¬ 
trance  into  a  wind  data  cell  of  a  fallout  parcel  trans¬ 
ported  from  a  contiguous  cell. 

CALC 

OPM 

PCHECK 

Computes  map  contributions  from  individual  deposit  in¬ 
crements  of  fallout  and  adds  these  to  the  map  ordinate 
array  OMAP. 

CALIB 

DTM 

TRANP 

Returns  a  justified  index  which  relates  a  point  to  its 
corresponding  position  in  a  data  array. 

CNTR 

DTM 

SUMDAT 

TRANP 

TRIDIN 

Returns  horizontal  coordinates  of  the  center  of  a  wind 

field  space  cel  1 . 

CONTOR 

OPM 

0PM2 

Determines  unordered  sets  of  map  points  that  lie  on 
specified  contours. 

CPFR 

ICRM 

CRM 

Computes  fallout  rate  from  the  cloud  during  its  rise. 

CRM 

ICRM 

ICRMX 

Executive  code  for  cloud  rise  calculation. 

CRM I NT 

ICRM 

ICRMX 

Initialization  for  the  cloud  rise  calculation. 

CRMW 

ICRM 

CRM 

Prints  cloud  rise  history  table. 

CXPN 

ICRM 

CRM 

Tabulates  cloud  rise  history  table  and  tests  for  cloud 

stabil ization. 

TAolE  2  (con't.) 


Program 

Module 

Called 

B,V 

Description 

OAT  IN 

DTM 

DTMEX 

Directs  input  and  processing  of  wind  and  turbulence  data. 

DBG 

I  CRM 

CRM 

Prints  debug  output  for  the  cloud  rise  calculation. 

DCSN 

I  CRM 

CRM 

Sets  "wet"  and  "dry"  mode  switches  and  tests  for  abnormal 
cloud  rise. 

OERIV 

ICRM 

RKGILl 

Computes  differential  equation  values  at  each  time  step 
during  cloud  rise. 

DSTBN 

ICRM 

I  CM 

Computes  particle  size  distribution  histogram  tables. 

DTMEX 

DTM 

DTM  executive  code. 

DTMINT 

DTM 

DTMEX 

Initializes  for  the  DTM. 

DUMPER 

DTM 

ADVEC 

SPRVS 

Writes  deposit  increment  data  onto  external  unit  IPOUT, 
and  prints  these  data  if  requested. 

FRATIO 

OPM 

PAM1 

Computes  parameters  for  the  radial  distribution  fractiona¬ 
tion  model,  which  uses  them  to  distribute  activity  with 
particle  size. 

GETDA 

DTM 

TRANP 

Computes  an  average  wind  or  turbulence  component  from  the 
summed  data  arrays  (I,  eq.  (3.2.3)). 

GETUP 

DTM 

DAT  IN 

Prepares  the  horizontal  space  resolution  arrays  NET  and 
NETSU  for  a  horizontally  resolved  wind  field. 

GOGO 

OMP 

uPM2 

Controls  flow  of  deposit  increment  data  to  and  from  ex¬ 
ternal  storage,  and  calls  PCHECK  to  process  the  data 
for  map  preparation. 

GXPSR 

OPM 

PAM  2 

Computes  the  distribution  of  total  fission  produce  ac¬ 
tivity  with  particle  size,  FP. 

I  CM 

ICRM 

ICRMEX 

Controls  input  and  printing  of  basic  data,  and  controls 

calculation  of  initial  conditions  in  the  nuclear  cloud. 

ICRMEX 

ICRM 

ICRM  executive  code. 

INDCD2 

OPM 

PAM  2 

Computes  activity  induced  in  soil  lifted  by  the  cloud  and 
adds  this  to  the  activity  distribution. 
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TABLE  2  (con't.) 


Program 

Module 

Called 

Description 

LAYERS 

DTM 

OAT  IN 

Constructs  arrays  ZBH  and  ZCh'  of  atmosphere  strata  base 
and  center  altitudes  for  a  three-dimensionally  resolved 
wind  field. 

MAP 

OPM 

0PM2 

Constructs  and  prints  fallout  maps  from  the  map  ordinate 
array  OMAP. 

.MASS 

ICRM 

I  CM 

Returns  mass  of  fallout  material  in  the  cloud  (fireball) 
at  the  initial  time  for  a  surface  or  near  surface  burst. 

MCHDEP 

OPM 

PAM2 

Computes  the  distribution  of  a  single  radioactive  mass 
chain  with  particle  size. 

NEST 

DTM 

SPRVS 

SUMDAT 

TRANP 

BOUN 

Given  a  set  of  horizontal  space  coordinates,  returns  the 
index  of  the  space  net  mesh  and  its  horizontal  boundary 

coordinates. 

ONEDIN 

DTM 

DAT  IN 

Inputs  and  processes  wind  or  turbulence  data  for  a  hori¬ 
zontally  homogeneous  wind  field. 

OPMEX 

OPM 

OPM  executive  code. 

0PM1 

OPM 

OPMEX 

Initializes  for  the  OPM. 

0PM2 

OPM 

OPMEX 

Initial  izes  and  controls  computation  for  fallout  map 
prepa ration. 

PAM1 

OPM 

0PM1 

Executive  code  for  time- independent  part  of  the  rigorous 
activity  calculations. 

PAM1A 

OPM 

0PM1 

Matches  fission  type  parameter  FISSID  with  an  activity  K 
factor.  Used  for  pure  airbursts  and  specified  size- 
activity  particle  distributions. 

PAM  2 

OPM 

0PM2 

PCHECK 

Executive  code  for  the  time-dependent  part  of  the  rigor¬ 
ous  activity  code.  Computes  and  prints  the  activity 

distribution  table  FP. 

PAM2A 

OPM 

0PM2 

Computes  and  prints  the  activity  distribution  table  FP 
for  airbursts  and  specified  size-acti1.  ity  distributions. 

PCHECK 

OPM 

GOGO 

Computes  boundaries  of  the  contribution  el lipses  for 
fallout  deposit  increments.  (I,  sec.  5.2) 
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TABLE  2  (con't. ) 


Program 

Module 

Called 

_iY_ 

Description 

POMP 

OPM 

GOGO 

Writes  deposit  increment  data  onto  an  external  storage 
unit  for  these  deposit  increments  that  will  contribute 
to  subsequent  map  sections. 

RKGILL 

I  CRM 

CRM 

Integrates  cloud  rise  differential  equations  by  a  fourth- 
order  Runge-Kutta-Gill  algorithm. 

RSTR 

I  CRM 

CRM 

Preserves  or  restores  cloud  properties  during  integration 
of  the  cloud  rise  differential  equations.  Operates  with 

RKGILL. 

RSKP 

I  CRM 

ICRMEX 

Passes  through  the  cloud  rise  history  table  constructed 
during  the  dynamic  cloud  rise  simulation  such  as  to  de¬ 
velop  the  particle  cloud  structure. 

SETTLE 

I  CRM 

DTM 

CPFR 

RSXP 

SPRVS 

Returns  still  air,  gravity  settling  speed  of  a  sphere 
when  given  sphere  diameter  and  density,  and  atmospheric 
conditions. 

SHWIND 

ICRM 

ICRMEX 

Inputs  and  processes  shot-time  wind  data  for  use  in  com¬ 
puting  shear  effects  on  cloud  rise  and  in  advecting  the 
particle  cloud  during  the  period  of  cloud  rise. 

SPRVS 

DTM 

DTM  EX 

Controls  transport  of  fallout  parcels  from  the  stabilized 
cloud  to  ground  impact. 

SRTCNT 

OPM 

CONTOR 

Orders  (approximately)  the  map  contour  points  determined 
by  CONTOR. 

SUMDAT 

DTM 

DTMEX 

Computes  weighted  sums  of  wind  and  turbulence  data  (I, 
eq.  (3.2.2)). 

TEMP 

ICRM 

I  CM 

Returns  temperature  of  condensed  and  vapor  phase  material 
in  the  cloud  (fireball)  at  the  initial  time. 

TIMER 

ICRM 

I  CM 

Returns  the  time  at  which  the  initial  cloud  (fireball)  is 
defined. 

TRANP 

DTM 

ADVEC 

Returns  impact  point  coordinates  and  dispersion  variances 
of  a  fallout  parcel  base  or  top  given  its  coordinates  in 
the  stabilized  cloud. 

TRIDIN 

DTM 

DAT  IN 

Computes  a  three-dimensionally  resolved  wind  or  turbulence 
field  from  input  data. 

TABLE  2  (con1 t.) 


Program 

URAN 

VAPOR 

WILKNS 

WNDSFT 


Called 

Module  By 


Description 


0PM 

ICRM 


DTM 

ICRM 


pam2  Computes  activities  of  239U  and  239Np  produced  by 

capture  of  neutrons  by  the  238U  in  the  device. 

ICM  Returns  the  portion  of  the  fallout  mass  in  the  initial 

cloud  (fireball)  that  is  in  the  vapor  state.  (This 
datum  not  currently  used.) 

DATIN  Computes  turbulence  data  via  Wilkins'  method.  (I,  sec.  3.3) 

ICRMEX  Adjusts  horizontal  coordinates  of  individual  fallout 

parcels  to  account  for  advective  transport  during  cicud 
rise  and  stabilization. 
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as  given  in  the  see.  5  code  listings,  about  4100010  (1200008)  central 
memory  words,  including  those  used  by  the  operating  system,  are  required. 
Nine  external  storage  units,  including  three  system  1-0  units,  are  re¬ 
quired  (Table  i). 

Computing  time  is  strongly  dependent  on  the  scope  of  the  problem  in 
terms  of  number  and  type  of  wind  fields,  number  of  fallout  parcels  trans¬ 
ported  and  number  and  sizes  of  maps.  To  give  a  general  idea  of  computing 
time,  complete  simulations  of  test  shots  Johnie  Boy  (0.5  KT),  Jangle-S 
(1.2  KT),  Koon  (150  KT)  and  Zuni  (3380  KT)  were  done  in  a  single  run  in 
609  seconds  CPU  time  on  a  COC  6600  computer.  Single  H  +  1  hour  normalized 
exposure  rate  maps  were  produced  for  each.  Wind  fields  were  defined  by 
single,  updated  profiles,  and  100  particle  size  classes  and  20  cloud  sub¬ 
divisions  were  defined  for  each.  Layer-by-layer  transport  was  used,.  Wind 
updates  and  numbers  of  map  points  were: 


Shot 

Number  of 

Wind  Updates 

Number  of 
Map  Point' 

Johnie  Boy 

2 

846 

Jangle-S 

3 

3538 

Koon 

3 

1513 

Zuni 

6 

1829 

2.3  VARIABLE  DIMENSIONED  ARRAYS 

Variable  dimensioned  arrays  are  used  in  two  modules:  DTM  and  0PM. 

In  the  0PM  there  is  only  one  such  array,  0MAP,  the  map  ordinate  array.  The 
user  may  change  the  size  of  this  array  by  changing  two  numbers  in  Subroutine 
0PMEX.  These  are  the  dimensions  of  the  0MAP  array  and  the  value  of  the 
parameter  NMAP  (lines  133  and  135  of  Subroutine  OPMEX);  NMAP  should  equal 
the  0MAP  array  dimension.* 


* 

DELFIC  is  programmed  to  accommodate  maps  with  numbers  of  points  greater 
than  NMAP  (sec.  2.5). 


For  the  DTM  the  situation  is  more  complex  in  that  there  are  fifteen 
arrays,  many  of  which  are  multiply  dimensioned.  These  arrays  all  are  in¬ 
volved  in  space  and  time  resolution  of  the  wind  field. 

In  spatially  resolving  the  wind  field  we  separate  horizontal  from 
vertical  resolution  since  at  each  vertical  stratum  we  find  an  identical 
horizontal  net.  Thus,  the  parameter  NDATF  is  at  least  as  large  as  the 
total  number  of  mesh  units  in  the  horizontal  net,  and  KBHF  is  at  least  as 
large  as  the  number  of  vertical  strata.  The  parameter  LT IMF  is  at  least 
as  large  as  the  total  number  of  updates,  4ncl uding  the  initial  wind  field. 
See  lines  128  and  129  of  the  DTMEX  FORTRAN  listing.  For  the  other  param¬ 
eters  on  these  lines  of  the  listing:  ICF  and  JCF  are  at  least  as  large  as 
the  numbers  of  subdivisions  (i.e. ,  mesh  units)  along  the  x  and  y  axis  re¬ 
spectively  of  the  "control"  horizontal  space  resolution  net  (Appendix  A); 

NCF  is  at  least  as  large  as  4* (maximum  number  of  zeros  punched  in  MARY 
input  cards  for  any  level  of  mesh  subdivision);  MARF  >  MAXI ( ICF*JC F ,NCF) . 

For  wind  field;  that  are  not  spatially  resolved  in  the  horizontal, 
much  central  memory  storage  is  saved  by  the  following  designations: 

NDATF  -  ICF  =  JCF  =  NCF  -  MARF  =  1. 

The  arrays  on  lines  122  through  127  of  the  DTMEX  code  listing  must  be 
dimensioned  to  be  consistent  with  the  integer  quantities  discussed  above. 
Specifically,  we  must  have: 

NET ( ICF, JCF)  ,NETSU(NCF) ,WAVG(KBHF,LTIMF) 

USUM( KBHF, NDATF, LTIMF),VSUM( KBHF, NDATF, LTIMF) 

DXSUM( KBHF, NDATF, LTIMF) ,DYSUM( KBHF, NDATF, LTIMF) 

RSUM(KBHF, NDATF, LTIMF) ,CAVS(KBHF)  ,HDAV( LTIMF) 

ZBH(KBHF) ,ZCH(KBHF) ,TIMUP(LTIMF) ,MARY (MARF) 

WFZ ( KBHF , NDATF , LTIMF) ,TSUM( KBHF) . 

Thus,  if  for  a  particular  case  we  have  ICF  =  3,  JCF  =  4,  NCF  =  8,  KBHF  =  13, 
LTIMF  =  1,  then  NDATF  =  18  and  MARF  =  12,  and  we  should  have 

NET(3,4) ,NETSU(8) ,WAVG(13,1) 

USUM (13,18,1) , VSUM (13,18,1) 
etc. 


2.4  MAP  SPECIFICATION 


All  maps  are  rectangular  with  west-to-east  (x  axis),  south-to-north 
(y  axis)  orientation.  Boundary  coordinates  and  at  least  one  of  the  two 
grid  spacings  (the  x  axis  spacing)  must  be  specified.  If  the  y  axis  grid 
spacing  is  not  specified,  the  code  sets  it  on  the  assumption  of  10  and  6 
printed  characters  per  inch  in  the  horizontal  (x  axis)  and  vertical  (y  axis) 
directions  on  the  printer  paper  such  as  to  produce  a  spatially  undistorted 
map. 

Along  with  the  boundaries  and  grid  intervals,  the  user  may  specify  a 
combined  ground  roughness-survey  meter  response  correction  factor  which 
sometimes  is  warranted  in  comparing  calculated  with  observed  exposure  or 
exposure  rate  fallout  maps.  Predicted  exposure  rates  are  based  on  laboratory 
measurements  of  fission  product  yields  and  on  factors  called  exposure  rate 
multipliers  that  convert  the  fission  yields  for  individual  nuclides  to  ex¬ 
posure  rates  at  one  meter  height  above  an  infinite  plane  on  which  the  fission 
products  are  assumed  to  be  uniformly  distributed.  One  correction,  the  ground 
roughness  factor,  is  required  to  account  for  absorption  of  radiation  by  small 
irregularities,  or  roughness  elements,  in  an  actual  ground  surface.  The 
other  correction  is  necessary  to  account  fo1"  variation  of  response  of  survey 
meters  to  radiation  over  the  spectrum  of  wave  lengths  encountered.  Ground 
roughness  factors  for  Nevada  Test  Site  terrains  are  estimated  to  be  in  the 
range  of  0.70  to  0.75,  and  an  instrument  response  factor  of  about  0.75  is 
appropriate  for  commonly  used  survey  meters.  The  product  of  these  two  factors 
is  approximately  0.5,  and  this  factor  is  commonly  applied  to  calculated  fall¬ 
out  patterns  for  test  shots  whose  fallout  activity  was  measured  over  land. 

On  default  of  input,  this  parameter  (GRUFF)  is  set  to  unity. 

Any  number  of  maps  can  be  requested  (Table  3)  for  a  set  of  dimensional 
specifications  as  discussed  above.  These  dimensional  specifications  can  be 
changed  and  another  set  of  maps  can  be  requested,  etc.,  in  the  same  run. 

Along  with  a  map  request,  the  user  may  specify  certain  other  parameters 
(in  addition  to  a  mass  chain  specification  for  map  option  14  and  T!  and  T2 
which  are  required  for  various  options).  These  are: 
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TABLE  3 


MAP  REQUEST  OPTIONS 


Map  Option 
Code,  NREQ 

0 

X 

2 


4 


5 


6 


7 

8 


9 


10 


.11 


Description 

Termination  of  request  set. 

Count  of  fallout  deposit  increments  that  contribute  to 
each  map  ordinate. 

"A? 

Exposure  rate  normalized  to  H  +  1  hour  (Roentgen  hr-1). 

Exposure  rate  at  time  H  +  T1  hours,  accounting  for  time 
of  arrival  of  fallout.  (Roentgen  hr-1). 

* 

H  +  1  hour  normalized  exposure  rate  resulting  from 
particles  in  diameter  range  T1  to  T2  micrometers.** 
(Roentgen  hr-1). 

Integrated  exposure  from  H  +  T1  hours  to  infinity, 
accounting  for  time  of  arrival  of  fallout  by  the 
approximate  method. +  (Roentgen). 

Integrated  exposure  from  H  +  T1  to  H  +  T2  hours, 
accounting  for  time  of  arrival  of  fallout  by  the 
approximate  method. +  (Roentgen). 

Integrated  exposure  from  H  +  T1  to  H  +  T2  hours  assum¬ 
ing  all  fallout  has  arrived  by  H  +  T1  hours.  (Roentgen). 

Integrated  exposure  from  H  +  T1  hours  to  infinity  as¬ 
suming  all  fallout  has  arrived  by  H  +  T1  hours. 

(Roentgen) . 

Integrated  exposure  from  H  +  T1  hours  to  infinity,  ac¬ 
counting  for  time  of  arrival  of  fallout  by  the  exact 
method.'4  (Roentgen). 

Integrated  exposure  from  H  +  T1  to  H  +  T2  hours,  ac¬ 
counting  for  time  of  arrival  of  fallout  by  the  exact 
method.44'  (Roentgen). 

Mass  of  fallout  per  unit  area  (kg  m'3). 
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TABLE  3  (cori't.) 


Map  Option 
Code,  NREQ 


Descri ption 

Mass  of  fallout  per  unit  area  deposited  from  H  +  T1  to 
H  +  T2  hours  (kg  m-3). 

Mass  of  fallout  per  unit  area  deposited  by  particles  in 
diameter  range  T1  to  T2  micrometers.**  (kg  m“3). 

Activity  per  unit  area  from  an  individual  inass  chain  at 
T1  hours  in  units  of  curies  m“2,  or  in  equivalent  fissions 
nT2  if  T1  =  0. 


15  Time  of  onset  of  fallout,  (s) 

16  Time  of  cession  of  fallout,  (s) 

17  Diameter  of  smallest  particle  deposited,  (ym) 

18  Diameter  of  largest  particle  deposited,  (ym) 


A  "normalized"  calculation  is  one  in  which  it  is  assumed  that  all  fallout 
is  deposited  by  H  +  t  regardless  of  actual  deposition  time. 

When  specifying  T1  and  T2  particle  diameters,  make  T1  slightly  smaller 
and  T2  slightly  larger  than  the  tabulated  central  diameters  for  the 
particle  size  classes. 

The  t-1*26  decay  factor  is  used  to  compute  exposure  rate  at  times  other 
than  H  +  1  hour  (I,  sec.  4.3),  though  activity  at  H  +  1  hour  may  be  cal¬ 
culated  by  the  exact  method.  (See  I,  sec.  4.1) 

Warning:  This  calculation  probably  will  consume  a  lot  of  computer  time. 

A  complete  activity  calculation  is  done  for  each  deposit  increment  of 
fallout.  Consider  using  one  of  the  approximate  methods  (requests  5  and 


1.  A  parameter  that  specifies  which  of  two  optional  formats 
is  to  be  used  to  print  map  ordinate  values.  These  are: 

a.  The  two-line  E  format, 

NNNNNN 

±  V.VVV, 

which  is  to  be  interpreted  as 

±  V.VVV  x  10NNNNNN 

b.  The  two-line  F  11.3  format 

NNNNNN 

+  V.VVV, 

which  is  to  be  interpreted  as 
±  NNNNNNV.VVV. 

The  two-line  E  format  is  used  on  specification  default. 


2.  Parameters  QCUT  and  CUTMAP  which  define  lower  thresholds  for  ac¬ 
ceptance  of  contributions  from  single  deposit  increments  and  cumu¬ 
lative  contributions  respectively.  Thus  any  contribution  at  any 
map  point  with  value  less  than  QCUT  is  ignored,  and  any  total  con¬ 
tribution  at  any  point  less  than  CUTMAP  is  set  to  zero.  If  not 
specified  by  the  user,  these  parameters  are  set  by  the  code  to 
values  consistent  with  the  type  of  map  requested  and  the  time 
after  detonation.  (QCUT  is  the  same  as  u)mi-n  of  I,  sec.  5.2; 
also  see  Appendix  B) 

(Subroutine  0PM2) 


2.5  MAP  SIZE 

Fallout  map  ordinate  values  are  stored  in  an  array  OMAP  with  single, 
variable  dimension  NMAP  (sec.  2.3)  While  only  NMAP  points  can  be  stored  in 
central  memory,  there  is  almost  no  limitation  on  map  size.*  Maps  that  require 


The  only  limitation  on  map  size  is 
for  at  least  two  y  axis  columns  of 


that  there  be  space  in  central  memory 
points. 
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points  in  excess  o*  NMAP  are  computed  and  printed  in  sections.  The  code 
determines  the  number  of  sections  required  (Subroutine  0PM2)  and  during 
computation  of  each,  writes  deposit  increment  data  that  may  contribute  to 
subsequent  sections  on  external  storage  units  (Subroutine  PDMP). 


2.6  CONTOUR  POINT  DATA 

For  any  map  that  can  be  wholly  contained  in  the  OMAP  array  (i.e.,  with 
less  than  NMAP  points,  see  sec.  2.5),  x,y  coordinates  of  points  on  as  many 
as  eight  contours  can  be  punched  and  printed.  Subroutine  CONTOR  determines 
the  coordinates  by  straightforward  linear  interpolation,  and  Subroutine 
SRTCNT  attempts  to  order  them  in  sequence  around  closed  contours.  Multiple 
closures  are  accommodated.  The  ordering  procedure  is  simple:  each  point 
is  followed  by  the  point  closest  to  it  which  has  not  yet  been  sequenced. 

When  the  next  point  turns  out  to  be  the  first  point  in  the  sequence,  the 
contour  is  closed.  Thus,  the  first  and  last  points  in  the  list  for  a  closed 
contour  are  identical. 

This  simple  ordering  procedure  may  produce  false  closures  and  cross¬ 
overs.  Thus,  the  user  must  plot  the  contours  by  hand  and  compare  the  contour 
points  with  the  plots  carefully  before  attempting  to  use  them. 
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3.  DATA  INPUT 


3.1  INITIALIZATION  AND  CLOUD  RISE  MODULE  CARD  DESCRIPTIONS 


Card 

No.  Variables  and  Format  _ Data  Description 

1  DETID(12) ,(12A6)  ICRM  run  identification 


2  I C ( 20 )  ,(2014) 


3  W,FW, HEIGHT, ZBRSTZ, 

SLDTMP ,PHI , (8F10. 0) 


Control  Integers: 

i _ icQl 

1  0 
1 
2 


2 


0 

1 


3  IF(IC(3),GT.O) 


4  KATM 


5  IF( IC(5) ,NE. 0) 


6  IF ( IC(6).NE. 0) 


_ Action _ 

lognormal  particle  size  distribution 

power-law  particle  size  distribution 

tabular  particle  size  distribution 
(I,  sec.  2.1.6) 

siliceous  soil  (continental  soil, 
including  Nevada  Test  Site) 

calcareous  soil  (coral  soil,  includ¬ 
ing  Pacific  islands)  (see  card  3  below) 

causes  return  after  print  of  initial 
conditions.  Otherwise  calculation 
proceeds  to  cloud  rise  simulation. 

atmosphere  stability  data  (altitude, 
temp.,  press.,  relative  humidity, 
density  viscosity'  pr'nt  skip  integer. 
If  KATM=0,  do  noL  price  data.  KATM=N, 
print  data  at  every  Nth  altitude  in¬ 
crement  of  200m  beginning  at  -1000  :• 

200 ( KATM- l)m  tv  50  km. 

take  particle  distribution  to  be  a 
diameter-activity  fraction  distribu¬ 
tion.  Otherwise  take  it  to  be  a 
diameter-particle  number  (or  mass 
fraction)  distribution.  Normally, 

IC ( 5 )  is  left  blank. 

causes  printout  of  cloud  rise  debug 
data.  (Subroutine  DBG) 


defaul t  values : 


W  =  total  yield  (KT),  FW  =  fission  yield  (KT), 

HEIGHT  =  height  of  burst  above  ground  zero  (m), 

ZBRSTZ  =  altitude  relative  to  sea  level  of  ground  zero  (in) 

SLDTMP  =  temperature  (°K)  of  soil  solidification.  ( I ,sec . 2. 1 . 2) 
siliceous  soil  =  2200°K  l  , 
calcareous  soil  =  2800°K  f 's 
The  distribution  of  activity  with  particle  size  is 
this  temperature.  (I, sec.  4.2.2) 

PHI  =  fraction  of  available  energy  in  the  cloud  at  the  initial  time 
used  to  heat  air  and  soil.  The  remainder  is  used  to  vaporize 
and  heat  water.  Default  value  =  1.0. 


(see  card  2) 

sensitive  to 


4  NDSTR  ,KDI , IRAD, 

(2014) 


NDSTR  =  number  of  size  classes  in  the  particle  distribution  histo¬ 
gram.  Default  value  =  100,  but  default  not  allowed  for 
tabular  particle  size  distribution  ( IC ( 1 )  =  2  on  card  2) 
(I,  sec.  2.1.6  and  Appendices  A  and  B). 

KDI  =  number  of  vertical  cloud  subdivisions  in  the  initial  cloud 
for  each  particle  size  class.  Default  value  =  15  +  tn(W). 

IRAD  =  cloud  horizontal  subdivision  parameter.  Normally  this  is 
left  blank  ( I  ,sec.  2.3) 


23 


CRH  Card  Descriptions 


Card 

No. 

5 


6i 


Variables  and  Format 
XGZ . VGZ  ,TGZ ,  (8F10. 0) 


DNS.DMEAN.SD, 

(8F10.0) 


_ Data  Description _ 

XGZ  =  x  coordinate  (west  to  east,  m)  of  ground  zero 
YGZ  =  y  coordinate  (south  to  north,  m)  of  ground  zero 
TGZ  =  detonation  time  (s) 

Normally,  this  card  is  blank. 

For  lognormal  particle  size  distribution  ( TC ( 1 )  =  0  in  card  2) 
DNS  -  fallout  particle  density  (g  cm"3).  Default  value  =  2.6 
DMEAN  =  median  diameter  of  the  particle  number  vs.  diameter  dis¬ 
tribution  (pm).  Default  value  =  0.407  pm  and  SD  =  4.0 
SD  =  geometric  standard  deviarion  of  the  particle  number  vs. 

diameter  distribution  (dimensionless) 

(I, sec.  2.1.6  and  I,  Appendix  A) 


6p  DNS, CAYM, EXPO, 

(8F10.0) 


For  power-law  particle  size  distribution  ( IC ( 1 )  =  1  on  card  2) 
DNS  =  same  as  for  6s.. 

CAYM  =  k/mass  ratio  (mEXP0-l  kg'1) 

EXPO  =  exponential  parameter  X  (dimensiunl ess) 

(I,  sec.  2.1.6  arid  I,  Appendix  B) 


6t  DNS , (8F10. U) 


For  tabular  particie  size  distribution.  { I C- ( 1 )  =  2 
on  card  2) 

DNS  =  same  as  for  6t  (I,  sec.  2.1.6) 


6t:l 


6t":  NDSTR 
6t:NDSTR+l 


D1AM(1)  FMASS(l) 


DIAM(NDSTR)  ,FMASS(NDSTR) 
DIAM(NDSTR+1) 


For  tabular  particle  size  distribution  only.  ( IC ( 1 )  =  2  on  card  2) 
DIAM(I)  =  upper  (i.e.,  larger  particle)  boundary  diameter 

of  the  It.h  particle  size  class 

FMASS(I)  =  mass  or  activity  fraction  (depending  on  value  of 
IC ( 5)  on  card  2)  in  the  1th  particle  size  class 
DIAM(NDSTR+1 )  =  lower  (i.e.,  smaller  particle)  boundary  diameter 
of  the  NDSTRth  particle  size  class 
The  tabulation  begins  with  the  largest  particle  and  continues  in 
order  to  the  smallest.  (I,  sec.  2.1.6) 


Cards  1-6  are  read  by  Subroutine  ICM. 

Begin  atmospheric  stability  data  input  via  Subroutine  ATMR. 


7  AT  I D ( 1 2 ) ,  (12A6)  Atmospheric 

8  FMT (12) ,  ( 12A6)  Atmospheric 


stabil ity  data  identification. 

stability  data  object-time  format.  (See  cards  11) 


9 


SCALE(8) ,  (8F10.0) 


Atmospheric  stability  data  scale  factors.  Default  values  for 
SCALE ( 1 )  through  SCALE(6)  =  1.0.  (See  cards  11) 


10 


N1,N2,N3,N4,N5,N6,  Atmospheric  stability  data  input  field  pointers. 

(2014)  (See  cards  11) 
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ICRM  Card  Descriptions 


Card 

No. 


11.1 


11 


NAT 


Variables  and  Format 

AP(6),  (FMT,  see 
card  8) 


AP(6) 


_ Data  Description _ _ _ 

Altitude  (m)  =  (AP(N1)  +  SCALE(7))  *  SCALE(l)  (relative  to  sea  level) 
Temperature  (°K)  =  (AP(N2)  ^  SCALE(8))  *  SCALE(2) 

Pressure  (Pa)  =  AP(N3)  *  GCAL E ( 3 ) 

Relative  Humidity  (%)  =  AP(N4)  *  SCALE(4) 

Density  (kg  m~3)  =  AP(N5)  *  SCALE(5) 

Dynamic  Viscosity  (kg  m"'s_1)  =  AP(N6)  *  SCALE(6) 

Either  all  quantities  may  be  specified  or  as  few  as  four  may  be 
specified,  but  altitude,  temperature,  relative  humidity  arid 
either  of  pressure  or  density  must  be  specified;  the  missinq 
quantities  are  computed  ty  the  program.  The  field  pointers 
Nl,  N2,  etc.,  are  from  card  10  and  the  scale  factors,  SCALE ( I ) , 
are  from  card  2.  The  program  interpolates  the  data  into  arrays 
at  200m  altitude  intervals  from  -1000m  to  50  km  altitude  (rela¬ 
tive  to  sea  level),  and  supplies  standard  data  at  -1000m  and 
50  km  if  not  specified. 


12  AP(N1)  =  999999.,  Atmosphere  data  terminator. 

(FMT,  see  cards 
8  and  11) 


Begin  shot-time  wind  data  input  via  Subroutine  SHWIND.  These  winds  are  used 
to  account  for  effects  of  wind  shear  on  the  cloud  rise,  and  to  advect  fallout 
parcels  during  cloud  rise  and  stabilization. 


13  FORM  (6X,  A4)  Two  options  are  allowed: 

FORM  s  WINDaaMETEOROLOGICAL  (cols.  1  -  20)  for  wind  data  in 
meteorological  format;  that  is  in  terms  of:  altitude, 
speed,  and  angle  (clockwise  from  north)  from  which  the 
wind  is  coming. 

FORM  s  WIND6ARES0LVED  (cols.  1  -  14)  for  wind  data  in  resolved 
form;  that  is  in  terms  of  altitude  and  x(west  to  east) 
and  y(sjuth  to  north)  wind  components. 


14 

FMT(12) ,  (12A6) 

Wind  data 

object-time  format  (see  cards  17) 

15 

SCALE(5),  (8F10. ) 

Wind  data 
SCALE(3)  = 

scale  factors.  Default  values  for 
=  1.0.  (See  cards  17) 

16 

N1.N2.N3,  (2014) 

Wind  data 

input  field  pointers.  (See  cards 

■ k 

Here  and  elsewhere  in  this  section  the  symbol  A  indicates  a  blank  column  in  a  punched  card. 
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ICRM  Card  Descriptions 


Variables  and  Format 

AP(3) ,  (FMT,  see 
card  14) 


17:,. it-,.' 


_ _ Data  Description _ 

For  FORM  s  WINDAAMETEOROLOGICAL  (card  13): 

Altitude  (m)  =  (AP(N1)  +  SCALE (4 ) )  *  SCALE(l)  (relative  to  sea  level) 
VX(m  s'1)  =  AP(N3)  *  SCALE(’)  *  SIN(ir/180.  (AP(N2)  *  SCALE(3) 

+  SCALE(3  *  SCALE(5)  -  180.)) 

VY (m  s'1)  =  AP(N3)  *  SCALE(2)  *  C0S(it/180.  (AP(N2)  *  SCALE(3) 

+  SCALE(3)  *  SCALE(5)  -  180.)) 

For  FORM  s  WINDAARESOLVED  (card  13): 

Altitude  (m)  =  same  as  above. 

VX(m  s*1)  =  AP(N2)  *  SCAlE(2) 

VY(m  s'1)  =  AP(N3)  *  SCALER) 

Here  VX  and  VY  are  wind  components  in  the  west-to-east  and 
south-to-north  directions  respectively,  the  scale  factors, 

SCALE ( I ) ,  are  from  card  15  and  the  field  Dointers,  Nl,  N2, 

N3 ,  are  from  card  16. 


AP(N1)  =  999999. 
(FMT,  see  cards 
14  and  17) 


Wind  data  terminator. 


3.2  DIFFUSIVE  TRANSPORT  MODULF  CARD  DESCRIPTIONS 


Variables  and  Format 
DTMID( 12 ) ,  (12A6) 


MC(20),  (2014) 


Data  Description 


DTM  run  identification 

Control  integers: 

I  MC(I) 


MC  ( I )  _  _ Action _ 

0  Wind  field  is  horizontally  homo¬ 

geneous  (i.e.,  not  spatially  re¬ 
solved  in  the  horizontal).  At  any 
time,  the  wind  field  is  defined  by 
a  single  vertical  profile  of  two- 
dimensional  vectors;  vertical  wind 
components  are  taken  to  be  zero. 

IF(MC(l).NE.O)  The  wind  field  is  resolved  in  three 
dimension:,,  and  three-dimensional 
wind  vectors  are  considered. 

0  Print  raw  and  processed  wind  and 

turbulence  data  before  weiqhted 
sums  (I,  eq.  (3.2.2))  are  computed. 

1  Do  not  print  above. 

2  Print  above  (i.e.,  as  though  MC(2)=0) 
plus  print  the  data  after  weighting 
and  summing  (I,  eq.  (3.2.2)).  The 
latter  includes  weiahted-summed 
vector  orientation  angles  (I,  sec.  3.4). 
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DTM  Card  Descriptions 


Card 

No. 

2  (con't.) 


3 


Variables  and  Format 
MC(20),  (2014) 


ICX,  JCX,  NSEQ, 
(2014) 


Data  Description 


Control  integers: 


MC(I). 


I F(MC (3 ) . GT. 0) 
IF (MC ( 3 ) . GT. 1) 

0 

1 

I F(MC ( 5 ) . NE .  1 ) 
1 


Action 


Do  not  print  fallout  parcel 
descriptions  before  and  after 
transport. 

Print  fallout  parcel  descriptions 
before  transport. 

Print  deposit  increment  descrip¬ 
tions. 

Quick  transport  is  specified 
(I,  sec.  3.2.2) 

Layer-by-layer  transport  is  speci¬ 
fied  (I,  sec.  3.2.1) 

Suppresses  debug  print  from  Sub¬ 
routine  TRANP. 

Causes  debug  print  from  Subroutine 
TRANP.  Caution:  this  print  is 
vol umi nous. 

Sets  ratio  of  the  Lagrangian  time 
scale  of  turbulence  to  the  Eulerian 
length  scale  of  turbulence,  T,/DE, 
to  unity  in  the  settling  speed 
correction  for  turbulent  dispersion. 
This  option  gives  realistic  results. 

Sets  Tl/Dc  =  B/o  where  B  =  4  and 
aw  is  standard  deviation  of  vertical 
turbulence.  (I,  sec.  3.3) 


ICX  =  number  of  subdivisions  along  the  x(west-east)  axis  of  the 
wind  field  horizontal  space  resolution  "control"  net  (Appendix  A) 
JCX  =  same  as  ICX  but  for  the  y(south-north)  axis. 

NSEQ  =  sequence  number  of  the  first  fallout  parcel  to  be  processed 
in  the  parcel  descriptions  list  supplied  by  the  ICRM.  Parcels 
ahead  of  the  NSEQth  parcel  in  the  list  are  bypassed. 

Default  values  are  unity  for  all  three  parameters.  For  a  hori¬ 
zontally  homogeneous  wind  field,  this  card  is  normally  blank. 


WINT ,XLLC ,YLLC , 

TIMER,  EDDY,  (8F10.0)  WINT  =  grid  spacing  of  the  wind  field  horizontal  space  resolution 

"control"  net  (Appendix  A).  For  a  horizontally  homogeneous 
wind  field,  specify  a  large  number  (e.g.,  1.0E10). 

XLLC  =  coordinates  of  the  southwest  corner  of  the  atmospheric  trans- 
YLLC  port  space  (  i.e. ,  horizontal  "control"  net)  in  the  west-to-east 
and  south-to-north  directions  respectively.  (Appendix  A).  For 
a  horizontally  homogeneous  wind  field  specify  large  negative 
numbers  consistent  with  WINT  (e.g.,  -0.5E10,  -0.5E10) 

TIMEH=  transport  time  limit  (hrs.). 

EDDY  =  ratio  of  Lagrangian  to  Eulerian  turbulence  time  scales  B  (see 
card  2,  MC(6)  -  1.,  and  I,  footnote  p.  35).  Default  value  =  4. 
Normally  this  field  is  blank. 
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DIM  Card  Descriptions 


Card 

No.  Variables  and  Format  _ Data  Description 


Cards  1-4  are  read  by  !.  broutine  DTMINT. 

Begin  wind  and  turbulence  data  for  a  horizontally  homogeneous  wind  field  read  by  Subroutines 

DATIN  and  ONEDIN  (MC(1)  =  0). 

Vertical  components  are  not  considered. 

5h 

SPEC,  FORM,  LTIM, 
UPTIMH,  (A4 ,  2X,  A4, 
18X,  12,  F10.0) 

SPEC  is  used  to  distinguish  wind  data  from  turbulence  data  and 
to  terminate  the  input  of  data  sets.  FORM  distinguishes  two 
types  of  wind  data:  meteorological  and  resolved  (see  ICRM 
card  13),  and  two  modes  of  turbulence  data  specification:  card 
input  and  calculate  by  Wilkins'  method  (I,  sec.  3.3).  The  op¬ 
tions  for  SPEC  and  FORM  are  punched  as: 

WINDAAMETE0R0L0GICAL  (Cols.  1  -20) 

WINDAARESOLVED  (Cols.  1  -  14) 

TURBAAWILKINSAMETHOD  (Cols.  1  -  20) 

TURBAAINPUTADATA  (Cols.  1  -  16) 

NOaMOREaDATA  (Cols.  1  -  12) 

The  NO  MORE  DATA  card  is  the  last  DTM  input  card. 

LTIM  =  wind  or  turbulence  field  update  sequence  integer.  The 
shot-time  field  is  update  number  1.  LTIM  =  1  winds  must 
be  input  first  (Cols.  29  -  30). 

UPTIMH  =  time  (hrs.)  at  which  update  LTIM  begins.  (Note:  For 
each  wind  update  there  must  be  a  turbulence  update.) 

6h 

FMT ( 12) ,  (12A6) 

Object-time  format  for  wind  or  turbulence  data.  (See  cards  9h) 

7h 

SCALE ( 5 ) ,  (8F10.0) 

Data  scale  factors.  Default  values  for  SCALE ( 1 )  throuqh 

SCAL E ( 3 )  =  1.0.  (See  cards  9h.) 

8h 

Nl,  N2,  N3 

Data  input  field  pointers.  (See  cards  9h.) 

9h :  1 

AP(3) ,  (FMT,  see 
card  6h) 

For  both  wind  and  turbulence  data,  the  processing  is  as  for  ICRM 
cards  13  -  17.  Turbulence  data  must  be  specified  as 

FORM  =  INPUTADATA  (card  5h);  it  must  be  input  in  the  resolved 
format,  and  after  processing  must  consist  of  turbulence  energy 
density  dissipation  rates,  0,  (m2  s'3)  (I,  sec.  3.3). 

9h:KBH 

AP(3) 

lOh 

AP(N1)  =  999999.  , 

(FMT,  see  cards 

6h  and  9h) 

Data  set  terminator. 

Cards  5h  through  lOh  are  repeated  for  each  wind  update,  and  for  each  turbulence  field  for 
which  FORM  e  INPUT  DATA  (card  5h). 

Begin  data  to  define  the  three-dimensional  wind  and  turbulence  field  grid.  (MC(l).N'-.O) 

The  same  space  grid  is  used  for  all  updates.  Data  read  by  Subroutines  GETUP  and  LA'ERS. 
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DTM  Card  Descriptions 


Card 

No.  Variables  and  Format 

5r:l  MARY(l),  i-iARY (2 ) . 


_ Data  Description _ 

Horizontal  space  resolution  net  mesh  subdivision  flags. 
(Appendix  A) 


5r:N  ....  MARY(MARX) ,(3612) 


6r  TLAYR,  ( 1 IX ,  A4) 


Indicates  whether  the  data  to  follow  represent  base  or  center 
altitudes  of  the  atmosphere  vertical  strata: 
WINDaLAYERaCENTERaALTITUDES  (Cols.  1  -27) 
or 

WINDaLAYERaBASEaALTITUDES  (Cols.  1  -  25) 


7r:l  ZCH(l),  ZCH(2),...  Vertical  strata  base  or  center  altitudes  (m  relative  to  sea 

.  .  level)  as  indicated  on  card  6r. 


74 :N  ....  ZCH(KBHX),  999999.  , 
(8F10.0) 


Begin  data  for  the  three-dimensional ly  resolved  wind  and  turbulence  fields.  Three-dimensional  wind 
vectors  are  considered  (MC(l).NE.O). 

Data  read  by  Subroutines  DATIN  and  TRIDIN. 


8r  SPEC,  FORM,  LTIM,  Same  as  card  5h 

UPTIMH  (A4,  2X,  A4, 

18X,  12,  F10. 0) 


9r  ALPHA,  BETA,  NN, 

(2F10.0,  14) 


ALPHA  =  vertical  limiting  distance  used  by  the  interpolation 

method  which  fills  in  the  three-dimensional  atmospheric 
space  grid  cells  from  the  data  to  follow  (corresponds 
to  a  in  I,  eq.  (3.5.2)) 

BETA  =  same  as  ALPHA  but  for  the  horizontal  plane. 

NN  =  number  of  nearest  data  vectors  used  by  the  interpolation 
method  in  filling  in  the  atmospheric  space  grid  cells 
from  the  data  to  follow  (corresponds  to  N  in  I,  eqs. 
(3.5.1)  and  (3.5.2)). 


lOr  FMT ( 12) ,  (12A6) 


Object-time  format  for  wind  or  turbulence  data.  (See  cards  13r) 


llr  SCALE(8) ,  (8F10.0) 


Data  scale  factors.  Default  values  for  SCALE(l)  throuqh 
SCALE ( 3 )  and  SCALE(6)  =  1.0.  (See  cards  13r) 


12r  Nl,  N2,  N3,  N4,  N 5 ,  N6,  Data  input  field  pointers.  (See  cards  13r) 

(2014) 
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DTM  Card  Descriptions 


Card 

No.  Variables  and  Format 

13r : 1  AP(S) ,  (FMT ,  see 

card  lOr) 


13r:J  AP(5) 


z  (m,  altitude  relative  to  sea  level)  =  (AP(N1)+SCALE(4))*SCALE(1) 
x  (a;,  in  west  to  east  direction)  =  (AP(N5)+SCALE(7))*SCALE(6) 
y  (m,  in  south  to  north  direction)  =  (AP(N6)+SCALE(8))*SCALE(6) 
vertical  wind  component  (m  s'1)  =  AP(N4)*SCALE(2) 

For  FORM  e  METEOROLOGICAL: 


VX(m  s'1)  =  AP(N3)*SCALE(2)*SlN(it/180.  ( AP(N2)*SCALE(3)+ 
stai  r(m*srai  Fill  -inn  11 

VY(m  S'1)  =  AP(N3)*SCALE(2)*COS(u/18o! (AP(N2)*SCALE(3)+ 
SCALE ( 5 )*SCALE ( 3 )  -180.)) 

For  FORM  =  RESOLVED: 

VX(m  s'1)  or  0X(m2s'3)  =  AP (N2 )*SCALE ( 2 ) 

VY(m  s"1)  or  DV (m^s"3)  =  AP(N3)*SCALE( 2) 


Turbulence  data  must  be  specified  by  FORM  5  INPUTaDATA  (see  cards 
5h  and  8r);  it  must  be  in  the  resolved  format,  and  after  process¬ 
ing  must  consist  of  turbulence  energy  density  dissipation  rates, 
£,  (m2sec"3).  Vertical  turbulence  components  are  not  used. 


14r  AP(N1)  -  999999.,  Data  set  terminator. 

(FMT,  see  cards 
lOr  and  13r) 


Cards  8r  through  14r  are  repeated  for  each  wind  update  and  for  each  turbulence  field  for  which 
FORM  =  INPUTADATA  (Card  8r). 


Begin  specification  of  turbulence  i e  1  cL  to  be  calculated  by  Wilkins  method.  Applies  to  homogeneous 
and  nonhomogeneous  data  fields  (MC(1)  =  0  and  MC(l).NE.O),  and  the  turbulence  is  horizontally  iso¬ 
tropic.  (I,  sec.  3.3). 

Data  are  read  by  Subroutines  DATIN  and  WILKNS. 


5t  SPEC,  FORM,  LTIM,  Same  as  cards  oh  and  8r  except  that  SPEC  and  FORM  are  limited  to: 

UPTIMH,  (A4 ,  2X ,  A4 ,  TURBaaWILKINSaMETHOD  (Cols.  1  -  20) 

18X ,  12,  F10. 0) 

6t  U,  ZM,  ZO,  RL,  (4F10.0)  U  =  surface  wind  speed  (m  s'1) 

ZM  =  height  above  ground  (m)  at  which  U  is  measured  (usually  10m). 
ZO  -  aerodynamic  surface  roughness  length  (m) 

RL  =  reciprocal  of  Monin-Obukhov  length  (m-1) 

These  quantities  are  used  to  compute  e  as  a  function  of  altitude 
by  eq.  (I,  3.3.4).  On  default  (blank  card),  e  is  computed  as  a 
function  of  height  by  eq.  (1,  3.3.5). 


Cards  5t  and  6t  are  repeated  for  each  update  for  which  turbulence  is  to  be  calculated  by  Wilkins' 
method. 


DTM  data  input  is  terminated  by  a  card  of  type  5h,  8r,  5t  with  SPEC  s  NOaMOREADATA  (Cols.  1  -  12). 
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OPM  Card  Descriptions 


3.3  OUTPUT  PROCESSOR  MODULE  CARD  DESCRIPTIONS 
Card 

No.  Variables  and  Format _ Data  Description 

1  0PMID(12),  (12A6)  OPM  run  identification. 


2  I C (20 ) ,  (2014) 


Control  Integers: 

I  IC(I) 

1  IF(IC(l).GT.O) 


2  IF( IC(2 ) . GT. 0) 


_ Action 

Do  not  call  PAM1  or  PAM1A  to  per¬ 
form  the  time  invarlent  part  of 
the  particle  activity  calculation 
and  stop  after  preliminary  process¬ 
ing  and  printout. 

Print  all  of  the  deposit  increment 
descriptions  received  from  the  DTM. 


3  NPRNT(6),  NPRNT(7) , 

NPRNT(9)-*-NPRNT(l3) , 
NPRNT ( 15) ,  (8L1) 


Particle  activity  calculation  data  print  control: 

Index  Printout  if  NPRNT( Index)  »  true 

6  Refractory  Fractions  (FR) 

7  Square  Root  of  FR  (BSUBK) 

9  Nucl ide  Abundances  (Warning  - 

This  option  combined  with  JD  = 

FALSE  will  bury  you  in  paper) 

10  Fission  Product  Activity  vs. 

Part  Size  (Warning  -  see  9) 

11  Induced  Activity  (Soil)  vs. 

Part  Size  (Warning  -  see  9) 

12  Induced  Activity  (Mass  239)  vs. 

Part  Size  (Warning  -  see  9) 

13  Selected  Mass  Chain  Activity 
vs.  Part  Size 

The  array  FP  of  total  activity  with  particle  size  is 
printed  if  NPRNT (15)  =  false.  Normally  this  card  is 
blank. 


4  FISSID,  EMITN , 

CAPFIS,  (A6,  4X, 
2F10.3) 


FISSID  =  fission  type.  One  of  the  twelve  types  listed  on  p.  43 
of  Vol .  I.  For  examplo,  FISSID  s  IJ235HE  (Cols.  1  -  6). 

EMITN  =  number  of  neutrons  produced  per  fission.  Used  to  com¬ 
pute  induced  activity  ir  soil  fallout.  Applicable  only 
to  continental  (silicerus)  soils.  IF(EMITN.LE.O.O) 
induced  activity  is  not  computed. 

CAPFIS  =  number  of  neutrons  capered  by  238IJ  Der  fission.  Used 
to  compute  induced  activity  in  device  material.  Not 
applicable  unless  FISSID  specifies  a  238ll  type  of 
fission.  IF(CAPF1S.  EC’.O.O)  induced  activity  in  238U 
is  not  computed. 


Cards  1  to  4  are  read  by  Subroutine  0PM1. 

Begin  fallout  map  specification  data  read  by  Subroutine  0PM2.  (sec.  2.4  through  2.6) 
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OPM  Card  Descriptions 


Card 

No.  Variables  and  Format 

5  XMIN  ,XMAX,YMIN,YMAX, 

DGX.DGY, GRUFF, 

(7F10, 3) 


_ _ Data  Description _ _ _ 

XMIN  are  the  minimum  and  maximum  map  coordinates  (m)  in  the 

XMAX  west-to-east  direction. 

YMIN  are  the  minimum  and  maximum  map  coordinates  (m)  in  the 

YMAX  south-to-north  direction  (m). 

DGX  are  the  map  grid  intervals  (m)  in  the  west-east  and  south- 

DGY  north  directions  respectively. 

If  DGY  is  not  specified,  it  is  computed  by  the  program  to 
produce  a  spatially  undistorted  map  (sec.  2.4). 

GRUFF  =  a  combined  ground  roughness-survey  instrument  correc¬ 
tion  factor  sometimes  applied  to  calculated  map  ordinate 
values.  To  compare  calculated  with  observed  test  shot 
activity  data  observed  over  land,  GRUFF  «  0.5.  Default 
value  -  1.0.  (sec.  2.4) 


6  nreq,jc,icont,maschn, 

T1,T2,QC'JT,CUTMAP, 

(4I5.4F10.0) 


Map  request  card.  A  map  with  geometry  as  specified  on  the 
preceding  card  5  is  comput'd  and  printed  according  to: 

NREQ  =  map  request  option  code.  (See  Table  3.) 

JC  =  0  or  1,  print  the  map  with  the  two-line  E  format 
JC  =  2,  print  the  map  with  the  two-line  F11.3  format 
(sec.  2.4) 

ICONT  i  0  do  not  compute  contour  points  and  do  not  read  cards 
7  and  8. 

ICONT  =  1  print  and  punch  x,y  map  coordinate  points  on  the 
contours  specified  on  card  7,  providing  a  nonblank 
label  is  specified  on  card  8. 

ICONT  >  1  compute  and  print  x,y  map  coordinate  points  on  the 
contours  specified  on  card  7  provided  a  nonblank 
label  is  entered  on  card  8.  Do  not  punch  the  data. 

Applicable  only  to  maps  that  can  be  wholly  contained 
by  the  ordinate  array  OMAP(NMAP). 

MASCHN  Atomic  mass  number  of  the  mass  chain  for  which  activity 
is  to  be  calculated.  Applicable  only  for  NREQ  =  14. 
(See  Table  3. ) 

T1.T2  time  range  (hrs  relative  to  detonation)  or  particle 

diameter  range  (pm)  for  activity  or  other  calculations. 
(See  Tabl e  3. ) 

QCUT  threshold  value  for  acceptance  of  a  contribution  at  any 
map  point  from  an  individual  fallout  deposit  increment. 
Computed  by  the  program  If  not  specified. 

CUTMAP  threshold  value  for  print  of  a  completed  map  ordinate 
value.  Computed  by  the  program  if  not  specified. 


7  CONTUR (8 )  .(8F10.0)  Read  only  if  ICONT. NF..0  (card  6).  Values  of  activity  or  other 

quantity,  depending  on  type  of  map,  for  which  map  x,y  coordinates 
are  to  be  printed  and  punched.  These  data  can  be  used  for  con¬ 
tour  plotting.  A  maximum  of  eight  values  are  allowed  per  map. 
Restricted  to  maps  that  can  be  wholly  contained  in  the  ordinate 
array  OMAP(NMAP) .  (sec.  2.6) 
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OPM  Card  Descriptions 


Card 

No.  Variables  and  Format 

8  CRDLSL, (A10) 


Card  6,  and  cards  7  and  8  if  necessary,  are  repeated  for  as  many  maps  as  desired  with  the 
geometry  specified  by  the  preceding  card  5;  a  blank  card  6  terminates  map  production  for 
this  geometry. 


Card  5  is  repeated  to  define  a  new  map  geometry,  and  is  followed  by  a  set  of  cards  6  and 
cards  7  and  8  if  necessary.  The  run  is  terminated  by  a  blank  card  5. 


3.4  PAM  TAPE  DATA 

Fission  yield  data  are  input  to  the  Particle  Activity  Submodule  (Subroutine  PAM1)  from  external  unit 
INPAM  (Table  l).  The  data  are  in  twelve  blocks  of  692  words,  each  block  preceded  by  a  six-character 
fissiori-type  identification  corresponding  to  the  twelve  FISSID  designations.  (See  I,  sec.  4.1  and  OPM 
card  4.)  Formats  are  (AC)  and  (5E146).  The  data  are  listed  in  Appendix  C. 


_ _ _ Data  Description _ _ 

Read  only  if  ICONT.NE.Q  (Card  6).  Label  to  be  punched  in  each 
contour  card  resulting  from  the  card  7  specifications.  Print 
and  punch  of  these  data  will  not  occur  unless  a  nonb'lank  label 
is  specified. 
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*  DEC  K»  TRPL  TRPL 

SUB  ROUT  I NE  TRPL  (  TRPL 

1  ARG  y  NPR,  PARA,  FAF8,  VR3)  TRPL 

TRPL 

+  **».*****«.*  *■**  *<»**  ♦*¥#*•»■»*♦♦♦♦*■***♦*•****  *****♦*****•****♦•**•**#■*******¥*  TRPL 

TRPL 

TRPL  USES  LINEAR  INTERPOLATION  TC  LOCATE  POSITION  OF  ARG  WITHIN  TRPL 
THE  ONE-OI MENSIONAL  ARRAY  PARA  ANO  COMPUTES  FOR  THE  CORRESPONDING  TRPL 
POSITION  IN  THE  ONE-OIMENS IONAL  ARRAY  PARS,  VK  B »  NPR  IS  THE  TRPL 

DIMENSION  OF  PARA  A  N  C  PARB  {WHOSE  ELEMENTS  CORRESPOND  ONt.  TO  ONE).  TRPL 
IF  ARG  IS  OUTSIDE  THE  TABULATED  VALUES  OF  FARA  ,  VR8  IS  SELECTED  TRPL 
FROM  THE  CORRESPONDING  END  OF  PAR8.  TRPL 

PARA  IS  ORDERED  FROM  LEAST  (PARA  (1))  TO  GREATEST  (PARA  l NPR) )  TRPL 

TRPL 

***•*»  **»***4*#«.****4'#»**  #*«+*»*»  *¥***0-V*  ■****♦**.  **♦■¥•  ***»*•***■**'¥•***  PL 

TRPL 

DIMENSION  TRPL 

1  PARA  (  NPR),  PARB  (NPR)  TRPL 

TRPL 

»»«.*#**  +  *•**********«  ********** ••****»**•«**»**»¥*  #***.* »»♦**** **TRPL 


***♦♦*****♦*♦*♦#***♦«*•»  +  *♦*****♦**♦*•***»♦♦•  ♦♦*♦*♦***¥*****■*  TRPL 

TRPL 


020  IF  (ARG  -  PARA  (1))  022,  022,  040  TRPL 

C 22  MB  =  1  TRPL 

024  VRB  =  1-ARB  (MB)  TRPL 

126  RETURN  TRPL 

040  DO  0  F I*  MA  =2,  NPR.  TRPL 

IF  (ARG  -  PARA  <  M.A )  )  048  ,  Ci44,'  054  TRPL 

C  44  MB  =  M',  TRPL 

GO  TO  024  TRPL 

048  VRB  =  (ARG  -  PARA  (MA  -  1) )  *  i PARB  (MA)  -  PARB  (MA  -  1 ) )  f  TRPL 

1  (PARA  (MA)  -  PARA  (MA  -  i)>  +  PARB  (MA  -  1)  TRPL 

GO  TO  0  26  TRPL. 

154  CONTINUE  TRPL 

MB  =  N°R  TRPL 

GO  TO  024  TRPL 

END  TRPL 
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♦DECK, ERROR  ERROR 

SUBROUTINE  ERROR  < FROSRM , IRROR , I SOUT >  ERROR 

T.  W.  SCHWENKE  ERROR 

1  MARCH  1966  ERROR 

ERROR 


*♦#********.*.***.»************♦****♦***».*♦*•*  +  *****#*■**♦¥•*■¥•■****«'•  ■hmmmmm**»ERRCR 


ERROR 

THIS  PROGRAM  WRITES  A  GENERALIZED  ERROR.  COMMENT  OR  THE  FOLLOWING  ERROR 

FORM  ON  TAPE  ISOUT  A  SO  THEN  RETURNS  IF  THE  SIGN  CF  IRROR  IS  ERROR 

POSITIVE  OR  STOPS  IF  ITS  SIGN  IS  NEGATIVES  ERROR 

ERROR 

ERROR  SENSED  IN  PROGRAM  (PROGRM)  AT  CR  NEAR  STATEMENT  NUMBER  ERROR 
(IRROR).  PLEASE  REFER  TO  THE  PROGRAM  LISTING.  ERROR 

ERROR 

PRIOR  TO  CALLING  ERROR  THE  PARAMETER  PROGRM  MUST  BE  SET  ERROR 

WITH  THE  BCD  NAME  CF  THE  CALLING  ERROR 

PROGRAM  ANO  PARAMETER  IRROR  MUST  BE  SET  WITH  THE  NUMBER  OF  THE  ERROR 
FORTRAN  STATEMENT  WHICH  BEST  IDENTIFIES  THE  ERROR  CONDITION.  ERROR 

ERROR 


ERROR 

1  FORMA T ( //2  6H  ERROR  SENSED  IN  PROGRAM  A6,3.0H  AT  OR  NEAR  STATEMENTS RROR 
i  NUMBER  I6,4QH  .  PLEASE  REFER  TC  THE  PROGRAM  LISTING.)  ERROR 

ERROR 

**  +  +*«.*  +  «»**»********.*«#*.»*«***  «4  *#*«*  +  **»*  »»¥*»♦**,„♦♦♦♦♦♦♦*♦**  «►***,£  f^f<0  R 
***♦*♦♦**  *♦***♦  **«»**«*.*««#*****«*»»»********* 


ERROR 

IRR=  IABSt IRROR) 

ERROR 

WRITE<ISOUT,l) PROGKM.IRR 

ERROR 

IF ( IRRO  R)10i»100 ,100 

ERROR 

100 

RETURN 

ERROR 

101 

STOP 

ERROR 

END 

ERROR 
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*DECK, SETTLE 

SUBROUTINE  SETTLE  CO  .RHOlSRHQ.ET  A,T  »P  ,V  ,1) 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976 

COMPUTES  STILL-AIR  SETTLING  SPEED  OF  RIGID  SPHERES  ACCORDING  TO 
THE  EQUATIONS  OF  BEAfiO  C J AS  33 , 8 52 C 19  76 ) )  FOR  SMALL  SPHERES 
(CORR  .LE.  84.175),  AND  DA  VIES ( PROC. PH YS  .SOC  .  C LC NOON ) 57 , 2 56 C 1945 
FOR  LARGER  SPHERES  . 


GLOSSARY  (SI  UNITS) 

C  4. 0*G/ 3«  0  RHERE  G  IS  ACCELERATION  OF  GRAVITY  (9.3) 

CORR  DAVIES  NUMBER 

0  SPHERE  OIAMETER 

ETA  VISCOSITY 

P  PRESSURE 

PHO  FLUID  DENSITY 

RHOP  SPHERE  OENSITY 

T  TEMPERATURE 

V  SETTLING  SPEEO 

I  ACCURACY  INDICATOR 

I  =  Q  RESULT  IS  ACCURATE 

1=1  RESULT  IS  INACCURATE,  DAVIES  NUMBER  IS  TOO  LARGE 

DATA  C/13.066667/ 

C 

I  =  1 

COMPUTE  DAVIES  NUMBER 

CDRR  =  C*(RHOP-RHO>*RHQ*C**3/ETA*l,-2 
CHECK  DAVIES  NUMBER  VALUE  FOP.  ROUTING 

IF  (CORR.GT  .  0.3261)  IF  (CORR-8  4.  175)  1(0,100*2  00 

COMPUTE  VIA  STOKES-LAM  EQUATION 

V  =  C0RR*ETA/(24,3*RH0*0) 

GO  TO  535 

COMPUTE  VIA  BEARDS  EQUATION 
100  Y  =  ALOG(CORR) 

V  =  ETA/(RHO*D)*EXP  (-3.  18657  ♦  Y*(Q,  992696  +  Y*  (~0. 15 319  3E-2 
1+YM-0.987059E-3  +  Y*  ( -C  .  57  0  87  0E-3  «■  Y* ( u . 8551 76E-4 
2-Y*0.327615E-5)) ))) ) 

GO  TO  5  Q  0 

COMPUTE  VIA  DAVIES  EQUATIONS 
2C  0  IF( CORR.GT .140 .) IF ( CORR- 4. 5 E7 )  4 0 0 » 40 8 , 30 0 

V  =  ETA/(RHO*D)*CORR* (4. 16666667E-2  ♦  CORR* ( -2 . 3 363E- 4 
1*C0RR*  (  2«0154E-6-CDRR*6.91Q5E-9)  )) 

GO  TO  500 
300  1=1 

400  Y  =  ALOGlO (CORR) 

V  =  ETA  /  (RHO*D  )  *  ( 10  •  0)**  (  - 1  •  29536  ♦  YM0.986  f  YM-Q  .046677* 
1Y*1.123  5E- 3 ) t ) 

RETURN 

CORRECT  SETTLING  SPEEO  FCR  SLIP 
500  V  =  V *(1.0  ♦  54. 088*ETA*SQRT(T) /P/O) 

RETURN 

END 


SETTL  1 
SETTL  2 
SETTL  3 
SETTL  4 
SETTL  5 
SETTL  6 
SETTL  7 
) ) SETTL  8 
SETTL  9 
SETTL  10 
SETTL  11 
SETTL  12 
SETTL  13 
SETTL  14 
SETTL  15 
SETTL  16 
SETTL  17 
SETTL  18 
SETTL  19 
SETTL  20 
SETTL  cl 
SETTL  22 
SETTL  23 
SETTl  24 
SETTL  25 
SETTL  26 
SETTL  27 
SETTL  28 
SETTL  29 
SETTL  30 
SETTL  31 
SETTL  32 
SETTL  33 
SETTL  34 
SETTL  35 
SETTL  36 
SETTL  37 
SETTL  38 
SETTL  39 
SETTL  40 
SETTL  41 
SETTL  42 
SETTL  43 
SETTL  h4 
SETTL  <*5 
SETTL  4b 
SETTL  47 
SETTL  48 
SETTL  49 
SETTL  5 G 
SETTL  51 
SETTL  52 
SETTL  53 
SETTL  54 


54 
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♦OECK,  ICRMEX 

SU3R0UT INE 


ICRHEX  (NUMTAP  ) 
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H.  G.  NORMENT.  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  197E 


ICRME 
ICRME 
ICRME 
ICRME 
ICRME 

#*****#**#«#*****#*##•*#«  «*»*+#«+*«  ****4.+*  *«**««»*  *  **#**»*****«***#**»xcfi:ME 

ICRME 

INITIALIZATION  AND  CLOUD  RISE  MODULE  ICRME 

ICRME 

DETERMINES  INITIAL  VALUES  OF  -  ICRME 

TIME,  TEMPERATURE,  TOTAL  SOIL  MASS,  FRACTION  OF  THE  SOIL  BURDEN  INICRME 


THE  VAPOR  PHASE,  ANC  THE  SIZE  FREQUENCY  DISTRIBUTION  OF  THE 
FALLOUT  PARTICLES,  NEXT  IT  PERFORMS  A  DYNAMIC  CLOUD  RISE  AND 
STABILIZATION  SIMULATION.  THEN  IT  ESTABLISHES  AN 
AXISYMMETRIC  DISTRIBUTION  OF  FALLOUT  PARCELS  ABOVE  GZ.  FINALLY 
THE  COORDINATES  OF  THESE  PARCELS  ARE  ADJUSTEO  TO  ACCOUNT  FOR 
HIND  TRANSPORT  DURING  THE  PERIOD  OF  CLOUD  RISE  AND  STABILIZATION 
AND  A  TRANSLATION  OF  THE  COORDINATES  OF  GZ  AND  CETONATION  TIME. 


GLOSSARY 


ALT 


ATMR 

ATID 

ATP 

BARMU 


BZ 

CAYM 

CG 

CHANGE 

CL 

CMLR 

CP 

CPA  I 
CPF  P 


CR 

CRM 

CRM INT  - 
CRM  W 
CX 


ICRME 
ICRME 
ICRME 
ICRME 
ICRME 
ICRME 
ICRME 
ICRME 

ICRME 

ARRAY (256) ,  A7MOSPHERE  ALTITUDE  IN  ME1 fcRS <MSL)  C ORRES POND I NG ICRME 
TO  ATP,  PRS,  RLH,  RHO,  ETA  ICRME 

SUBROUTINE,  READS  IN  fAGLES  OF  A LT , AT P,P RS , RLH , KHO  ,ET A 
ARRAY <12),  72  ALPHANUMERIC  CHARACTERS  FOR  ATMOSPHERE  IDENT 
ARRAY  <256) ,  AT  fOSPHERE  TEMPERATURE  <K)  MATCHES  ALT 
MEDIAN  DIAMETER  OF  THE  LOGNORMAL  PARTICLE  SIZE  VS.  VOLUME 
DISTRIBUTION  <  NICROMCTERS ) 

OEPOSIT  INCREMENT  LINEAR  OIMENSI ON <CX <5, MCX) /IRAD) 

K-TO-MASS  RATIO  PARAMETER  OF  THE  POWER- LAW  PARTICLE 
ARRAY (200)  ,  FALLING  SPEEDS  OF  PARTICLES  IN  THE  CLOUD 
CLOUD  TIME  AFTER  WHICH  STEP  LENGTH  CHANGES  TO  DST2 
LATENT  HEAT  OF  VAPORIZATION  OF  WATER 
CLOUO  MASS  LOSS  RATE  OF  PARTICULATE  FALLOUT 
SPECIFIC  HEAT  OF  AIR 
SPECIFIC  HEAT  OF  A IR 
SUBROUTINE,  COMPUTES 
RISE  CALCULATIONS 

WEIGHTEO  AVERAGE  SPECIFIC  HEAT  FOR  AIR  ANC  SOIL 
SUBROUTINE,  COMPUTES  DYNAMIC  CLOUD  RISt  AND  EXPANSION 
SUBROUTINE,  COMPUTES  INITIAL  CRM  VARIABLES 
SUBROUTINE,  PRINTS  CRM  OUTPUT 

ARRAY <50, 1J)  ,  CLOUD  PROPERTIES  VS.  TIME  COMPILED  DURING 
CALCULATIONS  ANO  USED  BY  RSXP  ANO  WNDSFT 


ICRME 
ICRMF. 
ICRME 
ICRME 
ICRME 
ICRME 
DISTBN. ICRME 


<  M/SEC)  ICRME 
ICRME 


INTEGRATED  FROM  TE  TO  T 

PARTICLE  FALLCUT  RATE  DURING  CLOUO 


CRM 


CXPN 

C2 


TI ME  <  SEC)  AFTER  BURST 

CLOUO  TIME  INTERVAL<SEC)  BEGINNING  AT  CX<J,1> 
BASE  <M )  AT  CX<J,1> 

TOP< M)  AT  CX<J,1) 

RADIUS <  M)  AT  GX<  J, 1) 

EASE  RATE  <M/SEC)  DURI NG  C X < J, 2) 

TOP  RATE  <  M/SEC )  CURING  CX<J,2) 

RADIAL  RATE ( M/SEC)  DURING  CX(J,2) 
TEMPERATURE  <K)  AT  CX<J,1) 

DENSITY  <KG/M**3)  AT  CX<J,1> 

CX  ARRAY 

MOMENTUM  GENERATION 


<J,i> 

<  J,2) 

<  J,3) 

( J ,  4 ) 

<  J ,  5  > 

<  J,6) 

C  J,  7*  > 

<  J,8) 

<  J  , 9) 

<J,10)  -  I N-CLCUD  GAS 
SUBROUTINE,  TABULATES 


CLOUO 

CLOUO 

CLOUO 

CLOUO 

CLOUO 

CLOUO 

CLCUO 


ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 

ICRME 


C3 

C6 


CONSTANT  USEO  IN  EOOY  VISCOSITY  MOMENTUM  GENERATION  ICRME 
<  YIEL  D  OEPEN  CENT)  ICRME 
CONSTANT  USEO  IN  COMPUTING  TURBULENT  ENERGY  DISSIPATION  RATE ICRME 
CONSTANT  USEO  IN  COMPUTING  AIR  ENTRAINMENT  RATE  INTO  CLOUO  ICRME 
CAUSED  BY  WIND  SHEAR  ICRME 
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DEK 
DM  EAN 

DERIV 
DETID 
0 1  AM 


DERIVATIVE  OF  EK  ICRME  61 
MEDIAN  DIAMETER  (MICROMETERS)  OF  A  LOGNORMAL  PARTICLE  ICRME  62 
SISE  DISTRIBUTION  ICRME  63 
SUBROUTINE,  EVALUATES  DERIVATIVES  OF  CLOUD  PROPERTIES  ICRME  64 
ARRAY (12) *  72  ALPHANUMERIC  DETONATION  IDENTIFICATION  ICRME  65 
A RRA Y ( 20 1)  ,  UPPER  BOUNDARY  OF  I-TH  PARTICLE  SIZE  CLASS.  ICRME  66 
THE  LAST  ENTRY  IN  THE  ARRAY  IS  THE  LOWER  BOUNDARY  OF  THE  ICRME  67 
LAST (SMALLEST)  PARTICLE  SIZE  CLASS.  THE  LENGTH  OF  THE  DIAM  ICRME  66 
ARRAY  IS  ALWAYS  ONE  GREATER  THAN  THE  NUMBER  OF  SIZE  CLASSES. ICRME  69 
(METERS)  ICRME  70 
FALLOUT  PARTICLE  OENSITY  (GM/CM**3),  DEFAULT  VALUE  IS  2.6  ICRME  71 
ARRAY (8,2)  ,  FALLOUT  PARCEL  VARIABLES  COMPILED  IN  ICRME  72 
SUBROUTINE  R3XP.  THE  SECONO  INDEX  IS  NEEDEO  ONLY  IN  THE  RSXPICRME  73 
CALCULATIONS  TO  DISTINGUISH  THE  PARCEL  TOP  FROM  BASE  ICRME  74 


DPS  TK 
OPX 


ORM 

OS 

OST 

OSTO 

OST1 

OST  2 

OT 

ou 

OV3L 

DWT 

OX 

oz 

ED 

EK 

EPS 

ERROR 

ES 


F 

FMASS 


FW 

GOP  ST 


( 1»MBT) 
( 2  ,MBT) 
(  3 ,  M  3T) 
( 4 , MBT) 
( 5, MBT ) 


TIME  (SEC)  OF  ALTITUDE  STABILIZATION  OR  GROUNOI NG ICRME  75 
ALTITUDE  OF  PARCEL  CENTER  OF  MASS  (METERS)  ICRME  76 
PAPCEL  RADIUS  AT  CENTER  OF  MASS  (METERS)  ICRME  77 
MEAN  PARTICLE  DIAMETER  (METERS)  ICRME  78 
PAPCEL  MASS  (KG)  FOR  A  SIZE-MASS  FRACTION  PARTIC LEICRME  79 


DISTRIBUTION 

PARCEL  ACTIVITY  FRACTION  FOR  A  SIZE-ACTIVITY 
FRACTION  PARTICLE  DISTRIBUTION 
(6, MBT)  -  PARCEL  VERTICAL  THICKNESS  <  METERS) 

(7, MBT)  -  ALTITUDE  OF  PARCEL  BASE  (METERS) 

(8, MBT)  -  PARCEL  VOLUME  (CUBIC  METERS) 

NUMBER  OF  FALLOUT  PARCELS  PER  PARTICLE  SIZE  CLASS 
A  RRA  Y (2  «  9  G  ) ,  FALLOUT  PANCE.  RISE  AND  EXPANSION  VARIABLE 
(i,J)  -  LIFT  RATE  FACTOR  ABOVE  CLOUD  BASE  (1/SEC) 

(2,J)  -  LIFT  RATE  FACTOR  3ELOW  CLOUD  BASE  (l/SEC) 

DERIVATIVE  OF  RM 
DERIVATIVE  OF  S 
INTEGRATION  TIME  STEP 
INITIAL  INTEGRATION  TIME  STEP 
INTERMEDIATE  INTEGRATION  TIME  STEP 
FINAL  VALUE  OF  INTEGRATION  TIME  STEP 
DERIVATIVE  OF  T 
DERIVATIVE  OF  l 

ARRAY (8) ,  USE  0  TO  TRANSMIT  VARIABLE  DERIVATIVES  TO  RKGILL 
DERIVATIVE  OF  WT 
DERIVATIVE  OF  X 
DERIVATIVE  OF  Z 

EOOY  VISCOSITY  LOSS  RATE  OF  KINETIC  ENERGY  OF  RISE 
TURBULENT  KINETIC  ENERGY  DENSITY 
KINETIC  ENERGY  LOSS  RATE 

SUBROUTINE,  FOR  GENERAL  UTILITY  ERROR  INDICATION 
SATURATION  PRESSURE  OF  WATER  VAPOR  (INVALID  FOR  TEMPERATURE 
ABOVE  BOILING  FOINT  OF  WATER) 

ARRAY  (25  6) ,  ATMOSPHERIC  DYNAMIC  VISCOSITY  (COEFF.  OF  VISC. 
( KGM/ (M-SEG) )  MATCHES  ALT  ARRAY 

IN  SUBROUTINE  RSXP,  TIME  INCREMENT  BETWEEN  WAFER  HISTORY 
DESCRIPTION  POINTS 

FRACTION  OF  W  IN  FIREBALL  AT  START  OF  RISE 

ARRAY(203) , PARTICLE  SIZE  CLASS  FRACTION  OF  TOTAL  MASS  OR 

ACTIVITY  LIFTEC  8Y  THE  CLOUD 

OBJECT  TIME  FORMAT  USED  TO  REA 0  LATA 

OESIGNAT ES  WHETHER  WINO  VELOCITIES  ARE  RESOLVED  OR  IN  FO LA R 
(METEOROLOGICAL  CONVENTION)  FORM 
FISSION  YIELD  IN  KILOTONS 

ARRAY  (1C,  1  C  5  ,  FALLOUT  PARCEL  V  ARIA  EL  ES  (OUTPUT  OF  KSXP) 
<1,J)  -  FALLOUT  PARCEL  X  COORDINATE  (METERS) 


PARCEL 

ALTITUDE 

PARCEL 

FALLOUT 


(l/SEC) 


DERIVATIVES 


RKGILL 


ICRME  80 
ICRME  81 
ICRME  82 
ICRME  83 
ICRME  84 
ICRME  85 
ICRME  36 
ABLE  ICRME  3  7 
ICRME  88 
ICRME  89 
ICRME  Si) 
ICRME  91 
ICRME  92 
ICRMt  93 
ICRME  94 
ICRME  95 
ICRME  96 
ICRME  97 
ILL  ICRME  98 
ICRME  99 
ICRMEi.G 
ICRME  1  £  1 
ICRME1 £2 
ICRME1.13 
ICRME  1 J4 
ICRME 1 C5 
ATURE  ICRME136 
ICRME1 £7 
VISC  .)  ICRME1  £8 
ICRME109 
kY  ICRMEilO 

ICRME 1 ll 
IC  i\ME  1 12 
OR  ICRME 113 

ICRME114 
ICRME 1 15 
IN  FOlAR  ICRME116 
ICRME117 
ICRME118 
KSXP)  ICRME 119 
ICRME120 


oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo 


HEIGHT  - 

HLR 

HOB 

IRAD 

IRISE  - 
I  SI  N 

ILOUT  - 
JBASE  - 


JPARN 

KBASE 


KDPST 

KSV 


LOO  0 


MCX 
MW V  A 


NOS  TR 
NHOOO 
P 

PHI 

PPS  T 

PRS 

PS 

PW 

Q 


( 2*  J)  -  FALLOUT  PARCEL  Y  COORDINATE  (METERS) 

( 3  * J  >  -  TIME  C (ORDINATE  (SEC) 

(  4,  J)  -  PARTICLE  0 IAMETER  (METERS) 

( 5 » J)  -  PARCEL  MASS  (KG)  FOR  A  SIZE-MASS  FRACTION  PARTICLE 
DISTRIBUTION 

PARCEL  ACT  1 VITY  FRACTION  FOR  A  SIZE- ACTIVITY 
FRACTION  PARTICLE  DISTRIBUTION 
<6,J>  -  Z  COCRCINA  TE  OF  PARCEL  CENTER  CF  MASS  (METERS) 
(7,J)  -  PARCEL  RADIUS  AT  CENTER  OF  MASS  (METERS) 

(8,J)  -  PARCEL  VERTICAL  THICKNESS  (METERS) 

( 9 » J )  -  ALTITUDE  OF  PARCEL  BASE  (METERS) 

( 1 3 ,  J )  -  PARCEL  VOLUME  (CUBIC  METERS) 

HEIGHT  OF  BURST  (METERS)  ABOVE  GROUND  ZERC 
(FOR  A  SUBSURFACE  BURST  INPUT  A  NEGATIVE  WALUE) 

RELATIVE  HUMIDITY  AT  ALTITUDE  OF  CLOUD  CENTER 
HEIGHT(FT)  OF  EURST  ABOVE  GROUND  ZERO 


CLOUD 


NUMBER  OF  CLOUC  DISC  RADIUS  SUBDIVISIONS  (SEE  BZ) 
LOGICAL  DESIGNATION  FOR  TAPE  USED  FOR  TEMFORY  STORAGE  IN 
AT  HR  AND  FOR  RSXP  OUTPUT 
INPUT  TAPE 
OUTPUT  TAPE 

COMPUTED  GO  TO  INDEX  USED  IN  SUBROUTINE  RSXP 

1  -  CONTINUE  OPST  TRAJECTORY  COMPUTATION 

2  -  OPST  TRAJECTORY  COMPUTATION  COMPLETE 
BINARY  OUTPUT  TAPE,  SUBRuUTINF  WNDSFT 
COMPUTED  GO  TC  INOEX  USED  IN  SUBROUTINE  RSXP 

\  -  AOJUST  OPST  RADIUS  AND  ACTIVITY  FOR  LEAVING  CLOUD 

2  -  ADJUSTMENT  OF  1  HAS  BEEN  MADE 

NUMBER  OF  OPST  RISE  ANO  EXPANSION  INTERVALS 

NUMBER  OF  VERTICAL  CLOUD  SUBDIVISIONS  TER  PARTICLE  SIZE 

IF  NOT  PUNCHED,  IT  IS  COMPUTED  IN  ICM 

IN  SUBROUTINE  RSXP,  NUMBER  OF  VERTICAL  SUBDIVISIONS  OF  A 
PARCEL  WHOSE  TCP  AND  BASE  RADII  ARE  NOT  ECUAL 
SEE  OPSTK 

INOEX  WHICH  DETERMINES  FUNCTION  UF  SUBROUTINE  RSTR 

1  -  PRESERVE  VARIABLES  AT  START  OF  TIMt.  STEP 

2  -  RESTORE  VAHABIES  TO  THOSE  AT  START  CF  TIME  STEP 
LENGTH  OF  PARCEL  DESCRIPTION  DATA  PLUCK  (GDPST  ARRAY  I 
RSXP) 

IN  SUBROUTINE  RSXP,  DISTINGUISHES  A  PARCEL  TOP  FROM  BASE 

MBT=1  SPECIFIES  A  PARCEL  TCP 

M0T=2  SPECIFIES  A  PARCEL  BASE 

NUMBER  OF  TIME  POINTS  (COLUMNS)  Or  CX  ARRAY 

1,  INITIAL  ENTRY  INTO  CXPN 

2,  REGULAR  ENTRY 

3,  FINAL  ENTRY 
CLOUO  MOOE  SWITCH 

NUMBER  OF  ELEMENTS  IN  ALT  AND  CORRESPONDING  ARRAYS 
LIMITS  OF  NAT  -  1,256 

NUMBER  OF  ENTRIFS  IN  PARTICLE  SIZE  CLASS  TABLE 
NUMBER  OF  ENTRIES  IN  THE  WIND  PROFILE  TABLE 
ATMOSPHERIC  PRESSURE  AT  CLOUD  CENTER  ALTITUDE  (PASCALS) 
FRACTION  OF  F*W  USED  TO  HEAT  AIR  AND  SOIL  AT  THE  INITIAL 
TIME.  THE  REMAINDER  IS  USED  TO  HEAT  WATER 


ICRME121 
ICRME12  2 
1CRME123 
ARTICLE  ICRME124 
I CRME125 
f  ICRMe.126 

ICRME127 
ETERS)  ICRME12  8 

ICRME129 
ICRME13C 
ICRME131 
ICRME1 32 
ICRME133 
ICRME134 
ICRME135 
ICRME136 
ICRME137 
GE  IN  ICRME13  8 

ICRME1 39 
ICRME140 
ICRME141 
ICRME1 42 
ICRME1 43 
ICRME1 44 
ICKME145 
ICRMEl 46 
UQ  ICRME147 

J.CRME1  46 
ICRME149 
SIZE  CL AS ICRME15  0 
ICRMEl 51 


PARTICLE 
THE  WIND 
AT  CLOUD 
TO  HEAT 


CORRESPONDING  ARRAYS 

SIZE  CLASS  TABLE 
PROFILE  TABLE 
CENTER  ALTITUDE  (PASCALS) 
AIR  AND  SOIL  AT  THE  INITIAL 


TIME.  THE  REMAINDER  IS  USED  TO  HEAT  WATER 
ARRAY (8,10),  TEMPORARY  STORAGE  OF  PARCEL  VARIABLES  IN  RSXP 
ARRAY (256)  ATMOSPHERIC  PRESSURE  (PASCALS)  MATCHES  ALT 
ARRAY(20U>,  PARTICLE  SIZE  CLASS  MIDPOINT  DIAMETER  (METERS) 
PARTIAL  PRESSURE  OF  WATER  VAPOR  IN  THE  CLCUD 
CONVERSION  FACTOR  FOR  FRACTION  MASS  TO  NUMBER  OF  PARTICLES 
PER  M**3 


1CkME152 
ICRMEl £3 
ICRMEl 54 
ICRME155 
ICRME156 
ICRMEl 57 
ICRMEl 5 8 
ICkMEI 59 
ICRME160 
ICRME161 
ICP.ME  1 62 
ICRMtl 63 
ICRME16', 
ICRMEl 65 
ICRME166 
1CRME167 
ICRME168 
1CRME169 
ICRME170 
ICRME171 
1CRME172 
ICKME173 
ICRMEl 7  4 
ICRME175 
ICRMEl 76 
ICRME177 
ICRMEl 7 8 
ICRMEl 79 
ICRME180 


57 


FACTOR  CONVERTS  CLOUD  TEMPERATURE  TO  VIRTUAL  CLOUO  ICRME181 
TEMPERATURE  ICRML182 
INVERSE  OF  FACTOR  TO  CONVERT  AMBIENT  TEMPERATURE  TC  ICRMF.193 
VIRTUAL  AMBIENT  TEMPERATURE  ICPME184 
CLOUD  HORIZONTAL  RAOIUS  ICRME185 
GAS  OENSITY  OF  CLOUD  ICRME186 
Pl/i.80,  CONVERTS  DEGREES  TO  RADIANS  ICRME187 
FALLOUT  PARCEL  RAOIUS  USEO  IN  SUBROUTINE  RSXP  ICRME138 
ARRAY  (2561  ATMOSPHERE  AIR  DENSITY  (KGM/M**3>  MATCHES  ALT.  ICRME139 
FALLOUT  PARTICLE  DENSITY  (KG/M**  3)  ICRME190 
SUBROUTINE,  RUNGE-KUTT A-GILL  INTEGRATION  ICRME191 
ENTRAINMENT  PARAMETER  IGRME192 
ARRAY (296)  AT  EOSPHERE  RELATIVE  HUMIDITY  MATCHES  A LT (PERCENT ICRME193 
CLOUO  MASS  ICRME194 
INITIAL  AIR  MASS  IN  CLOUO  1CRME195 
INITIAL  HATER  MASS  IN  CLOUD  ICPME196 
SUBROUTINE  WHICH  PRESERVES  ANU/OR  RESTORES  CRM  VARIABLES  1CRME197 
SUBROUTINE,  ESTABLISHES  FALLOUT  PARCEL  POSITIONS  IN  SPACE  ICRME199 
ABOVE  GZ  AT  STABILIZATION  TIME.  ICRME199 
VERTICAL  CLOUO  RAOIUS  ICRME230 
CONDENSED  SOIL  MIXING  RATIO  ICRME2C1 
GEOMETRIC  STANCARO  OEVIATICN  FOR  A  LOGNORMAL  PARTICLE  SIZE  ICRME2G2 


R 

RA 

RAOC 

RAO IUS 

RHO 

RHOP 

RKGILL 

RL 

RLH 

RM 

RMAO 
RMH  0 

RSTR 

RSXP 


EXPO 

SHAPE 

SHWINO 

SLDTMP 

SMALLT 

SOILHT 

SSAM 


TMPG 

TMPS 

T  MS  0 

TRPL 

TSRO 

TSTM 

T2M 

U 

V 

VBL 
VIS 
VPR 
VX(  I) 


TEMPERATURE  TC 


ICRME181 
ICRML182 
1CRMF.1 83 
ICPME184 
ICRME1 85 
ICRME1 86 
ICRME187 
ICRME138 
ICRME139 
ICRME190 
ICRME191 
I0RME192 


ARRAY (256) 
CLOUO  MASS 
INITIAL  AIR 


DISTRIBUTION 


EQUAL 


INFUT)  (DIMENSIONLESS)  ICRME203 


FOR  A  SIZE-ACTIVITY  PARTICLE  OISTBN.  THE  CODE  SETS  SD=-1.C 
EXPONENTIAL  PARAMETER  OF  THE  POWER-LAW  P  ARTICLE  OISTBN. 
EQUAL  TO  RZT/R.  A  CONSTANT  USED  TO  COMPUTE  CLOUO  SHAPE 
WHEN  U  .GT.  0.0 

SUBROUTINE,  READS  SHOT-TIME  WIND  DATA 

PARTICLE  SOLIDIFICATION  TEMPERATURE  (K)  DEFAULT  VALUE  22o0. 
TIME  AFTER  START  OF  COMPUTATION 

LATENT  HEAT  CF  VAPORIZATION  OF  CLOUO  SOIL  CONSTITUENT 
TOTAL  MASS  (KG)  OF  SOIL  (OR  WEAPON  0E9RIS  FOR  AN  AIRBURST) 
IN  THE  CLOUD  AT  THE  INITIAL  TIME 
CLOUO  TEMPERATURE  (K) 

ATMOSPHERIC  TEMPERATURE  AT  CLOUD  CENTER  ALTITUDE  (K) 

TIME  (SEC)  OF  CETONAT ION 

TIME  (SEC)  OF  INITIAL  CONDITIONS  SPECIFICATION  RELATIVE  TO 
DETONATION. 

INITIAL  VAPOR  TEMPERATURE  (K) 

INITIAL  TEMPERATURE  OF  CONCENSEQ  PHASE  MATERIAL  IN  CLOUO  (K 

TIME  OF  PARTICLE  SOLI OIFI C ATIO N  (SEC)  HITHIN  CLOUO 

SUBROUTINE,  LINEAR  INTERPOLATION 

R-RATE  CLOUO  RISE  TERMINATION  SWITCH  PARAMETER 

TIME  AT  WHICH  NEXT  CX  ARRAY  ENTRIES  ARE  TO  BE  MADE 

TIME  (SEC)  OF  THE  FIREBALL  SECOND  TEMPERATURE  MAXIMUM 

CLOUO  VERTICAL  VELOCITY 

CLOUO  VOLUME 


PHASE  MATERIAL  IN  CLOUO 
ISEC)  HITHIN  CLOUO 


)  ICRME2C4 
1CRME2C5 
1CRME2 a 6 
ICRME2C7 
ICRME208 
J.  ICRME2C9 
ICRME21 0 
ICRME211 
I  ICRME212 
1DRME213 
1CRME214 
ICRME215 
ICRMEZ16 
0  ICRME217 
ICRME218 
ICRME219 
(K)  ICRME 22 0 
ICRME221 
IGRME222 
ICRME223 
ICRME224 
ICRME225 
ICRME226 
ICRME227 


-  ARRAY (8) ,  OUMMY  VARIABLES  CF  I  NT EGR A V ICN ( S UB S .  DERIV , RKGILL)  ICRME228 


VIS  -  OYNAMIC  VISCOSITY  (KG/<M-S£C>) 

VPR  -  MASS  OF  FALLOUT  VAPOR  (KG)  AT  THE  INITIAL  TIME 
VX(I>  -  ARRAY (ICC),  X-COMPONENT  UF  WIND  VELOCITY  AT  WIND  PROFILE 
STRATUM  I,  (METERS/SEC) 

VY ( I)  -  ARRAY (100),  Y-COMPONENT  OF  WINO  VELOCITY  AT  HIND  PROFILE 
STRATUM  I,  (METERS/SEC) 

W  -  TOTAL  YIELO  <  KT ) 

WNOSFT  -  SUBROUTINE,  ACJUSTS  FALLOUT  PARCEL  COORDINATES  FOR  WIND 
TRANSPORT  OURING  RISE  AND  EX  FA  NS  ION  AND  FOR  COORDINATE 
TRANSLATION. 

WT  -  SOLID  ANO  LIQUID  WATER  MIXING  RATIC 

X  -  IN-CLOUD  HATER  VAPOR  MIXING  RATIC 


ICRME  229 
ICRME  23  0 
ICRME231 
ICRME232 
ICRME233 
ICRME  234 
1CP.ME235 
ICRME236 
ICRME  237 
ICRME238 
ICRME239 
1CRME240 


XE  -  AM3IENT  AIR  WATER  VAPOR  MIXING  RATIO 

X3Z  -  X  COORDINATE  OF  GRCUNQ  ZERO  (METERS) 

Y  -  ARRAY(20O)»  NUMBER  OF  IN-CLOUQ  PARTICLES/ UNIT  VOLUME  OF  CLOUD 

YGZ  -  Y  COORDINATE  OF  GROUND  ZERO  (METERS) 

Z  -  CLOUD  CENTER  ALTITUDE  (METERS) 

Z0FR  -  MAXIMUM  Z  OF  CURRENT  OR  PREVIOUS  ENTRIES  TABULATED  BY  CXPN 
ZBRSTZ  -  Z-COORDINATE  OF  BURST  GROUND  ZERO  (METtRS  ABOVE  MSL) 

ZLMT  -  UPPER  LIMIT  FOR  CLOUD  CENTER  ALTITUDE  TO  PREVENT  POSSIBLE 

COMPUTATIONAL  FUNAWAY 

ZSCL  -  SCALEO  HEIGHT  CF  BURST  IF T/ ( KT >** ( 1. 0/S. 4  ) ) 

ZV(I)  -  ALTITUDE  OF  CENTER  PLANE  OF  WINO  PROFILE  STRATUM  I  (M  MSL) 
ZVSB  -  IN  SUBROUTINE  RSXP,  DISTANCE  OF  A  PARCEL  ABOVE  CLOUD  BASE 


£  ¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥*¥¥¥¥¥¥¥¥¥*****¥¥¥¥¥¥*¥¥¥  ¥¥*¥¥¥¥¥*¥*¥¥¥#¥¥¥*■*¥■¥¥¥¥¥¥ 

C 

COMMON  /BASIC/  M  ,FW , ZBRS TZ , HEIGHT , ZSCL , SLC TMF, TMSD , XGZ , YGZ , TGZ 
COMMON  /CONTRL/  OETIO< 12) , IC < 20 ) ,IRAD, IRISE, IS IN,  I SOUT, JPARN.KDI 
COMMON  /TABLES/  MCX,  CX(50,10).  GDPS  T  (  1 J  ,  1 0  0) 

C 

DIMENSION  CXT I M ( 50 ) »CXTMP( 50 ) »  NUMTAP ( 1 5) 

EQUIVALENCE  ( C XT IM U ) , GDPST  (601 ) ) »  ( CXT MF ( 1 ) ,G OFST ( 651) ) 

C 

C  ¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥  **¥¥  +  ***  +  *¥*■»***•*■** 

C 

COPY  IN  BASIC  ANO  CONTROL  OATA,  ESTABLISH  CONDITIONS  IN  THE  FlkEBALL  AT 
C  INITIALIZATION  TIME,  SET  UP  FALLOUT  PAKTICLE  SIZE  DISTRIBUTION 

C  TABLES  AND  PRINT  HEADINGS  ANO  DATA. 

ISIN  =NUMTAP(  1) 

ISOUT=NUMTAP(  2) 

CALL  IC M 

IF ( IC ( 3 )  .NE.  0)  RETURN 
IRISE=NUMTAP(  3) 

JPARN=NUMTAP(  4) 

COFY  IN  ATMOSPHERE  OATA 
CALI.  ATMR 

COPY  IN  SHOT-TIME  WINO  DATA 
CALL  SHWINO 

COMPUTE  INITIAL  VALUES  FOR  THE  CLOUD  RISE  EQUATIONS 
CALL  CRMINT 

COMPUTE  THE  OYNAMIC  CLOUO  RISE 
CALL  CRM 

COMPUTE  TIME  OF  FALLOUT  SCL I  (I  FIC  ATI  UN 
DO  122  MA= 1, MCX 
MB=MCX-MA+1 
CXTIM(MA)=CX(M8,1) 

122  CXTHP(MA)=CX(MB,9> 

CALL  TRPL(SLOrMP,MCX,CXTMP,CXTIM,TMSD) 

WRITE(IS0UT,513)SLDTMP,TMS0 

513  FORMA T (  /////10X,42HTIME  OF  SOIL  SOLIDIFICATION  AT  TEMPE RATUREF1 J. 
14,  8H  DEG .  ISF9.4,  5H  SEC.) 

COMPUTE  FALLOUT  PARCEL  DISTRIBUTION  IN  SPACE  ABOVE  GZ  AT  STABL JZATION 
CALL  RSXP 

COMPUTE  WIND-ADJUSTED  FALLOUT  PARCEL  COORDINATES  AND  TRANSLATE  GZ  AND 
C  DETONATION  TIME  COCRCINATES,  WRITE  BINARY  OUTPUT  TAPE. 

CALL  WNDSFT 

RETURN 

ENO 
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ICRME243 
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ICRME277 
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ICRME279 
ICRME280 
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*0ECK,ICH  ICH 

SUBROUTINE  ICH  1CM 

I C  M 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  ICM 

ICM 

*****»»*»»****#**»***»«.*«»#*#«*#«#««#*«*.  4* +  **«#*«+ «**#»«#»***»*»*«««*»j;c  m 

ICM 

PROGRAM  TO  DETERMINE  THE  INITIAL  CONOITICNS  SPECIFICATIONS  OK  ICM 

TIME,  TEMPERATURE,  TOTAL  SOIL  MASS,  FRACTION  OF  THE  SOIL  BURCEN  INICH 
THE  VAPOR  PHASE,  ANC  THE  SIZE  FREQUENCY  DISTRIBUTION  OF  THE  ICM 

CONOENSEO  PHASE  SOIL  OR  AlRBURST  PARTICLES.  IT  ALSO  PRINTS  A  ICM 
HEADING  AND  PRINTS  THE  CRITICAL  OATA.  ICM 

ICM 

ICM 

COMMON  /BASIC/  W  »FW  *  ZBRSTZ , Htl GHT , ZS  CL , SLD  T  HP, TMSD ,XGZ*YGZ»TGZ  ICM 
COMMON  /CONTRL/  OET ID (12 > » IC (20 ) , IRA 0, IRISE , IS  IN , I SOUT, JPA RN ,S01  ICM 
COMMON  / INI TL/  F,  PHI,  SSAM,  THE,  TMPG,  TMPS,  VPR  ICM 

COMMON  /PAPTCL/  NOS TR ,RHCP, OMEAN »SD, PS < 20 0 ) , Cl  AM <20 1) , FM ASS ( 20 0 )  ICM 
EQUIVALENCE  ( 0 MEAN , CAYM ),( SO , EXPO  ICM 

ICM 

DATA  PROGRM  /6H  ICM  /  ICM 

ICM 

»#**«*»»*«****#*»¥«.»**«««**««***«,****«««.*»«**«**»««*#«*««**»***«#«»**  XCM 

ICM 

1  FORMAT (12A6)  ICM 

2  FORMAT (  /3X,  6QHTHE  SPECIFIED  STANOARD  DEVIATION  IS  NEGATIVE  HENCE IC M 

1  INCORRECT///)  ICM 

3  FORMAT ( 6F1 3 . 0 )  ICM 

4  FORMAT (  //25X,  2BH****  BASIC  PARAMETERS  **+*/  20X,  24HYIELDS  -  T ICM 

10TAL  (FISSION),  21X,  E12.5,  2H  (L12.5,  4H>  KT/  2QX,  24HHEIGHT  OR  OICM 
2EPTH  OF  BURST,  21X,  E12,5V  2X,  6HMETERS ,  2H  (Ei2.5,  21H  FEET)  KELA  ICM 
3TIVE  TO  GZ/  2QX,  14HALTI TUDE  OF  GZ,  31X  E12.5,  7H  METERS/  20X,  ICM 
4  13HS0IL  CATFGORY)  ICM 

5  FORMAT  ( J.H+  »  65 X,9HSILICE0 IS)  ICM 

6  FORMAT  ( 1H4-,  65  X,  10HCA  LCAREOUS)  ICM 

7  FORMAT (  /2QX,  36HPARTICL  E  SIZE  FREQUENCY  D IS T H IdUT 10 N/ IC M 

125X32HA  LOG-NORMAL  CISTRIBUTION  WITH  -/ 3 0 X , 1 5H M EOI AN  01 A  MET ER, 20 X , ICM 
2E12*5,2X,11HMICR0METERS/39X, 2 8H GEOMETRIC  STANDARD  DEVIATION,  7X,  ICM 

3E12.5/25X,  34HTHIS  DISTRIBUTION  WAS  SPECIFIED  BY)  ICM 

8  F0RMAT(lHF,65X,iiHTHE  PROGRAM)  ICM 

9  FORMAT! 1H*, fc5 X,0HTHE  USER)  ICM 

10  F OR MAT (2014)  ICM 

11  FORMAT ( /3X, 5ft  H THE  SCALED  OEPTH  OF  BURST  IS  BEY  ONC  THE  SCOPE  OF  THEICM 

1  MODEL)  ICM 

12  FORMAT  (  lit  *• ,  65X ,  36HMOT  APPLICABLE,  THIS  IS  AN  AlRBURST)  ICM 


13  FORMAT  <  //25X37H****  INITIAL  CLOUD  PROPERTIES  AT  H  +El2.5,14H  SECICH 

10N0S  ****/  2GX»23HA  VERAGE  GAS  TEMPEKAT  URE3  8X, E12, 5, 2X,14H DEGREES  ICM 

2KELVIN/  ?0 X , 5 6HA VERAGE  TEMPERATURE  OF  CONDENSED  PHASE  MATERIAL  IN  IOM 
3CLOUO,5X,E12. 5 , 2X , 1 4 FOEGREES  KELVIN/  20X,31HMASS  OF  VAPORIZED  SOILICM 

4  IN  CLOUD, 30X , E12 , 5 , 2X ,9HK ILOGR AMS/  2UX41HMASS  CF  CONDENSED  PHASE  ICM 

5  MATERIAL  IN  C  LOU  U,  2  0  X,  El  ?. .  5 , 2X,  9HKIL  OGR  A  NS  )  ICM 

14  FORMAT (  //25X37H****  INITIAL  CLOUD  PROPERTIES  AT  H  ♦E12.5,14H  SE-ICM 

10N0S  •**•/  20X, 23HAVERAGE  GAS  TEMPERATURE38X, E12. 5, 2X ,1 4HDEGREE S  ICM 

2KELVIN/  20X41HMASS  OF  CONDENSED  PHASE  ICM 

3  MATERIAL  I N  0  LOUD, 2 0 X, E 1 1, 5 , 2X, 9HKIL OGR A  NS )  ICM 

15  FORMAT! IX, 11HLEAVING  ICM)  ICM 

16  FORMAT!  1H1,  53X,  39H*  ****♦♦*♦  *//55X,UHO  E  L  F  I  C//  ICM 

1  12  X ,  10 1HT  HE  D  E  P  ICM 

2ARTMENT  OF  DEFENSE  FALLCIT  PREDIC  ICM 
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3T  I  0  N  S  Y  S  T  E 
4ALIZATI0N  A NO  CLOUO 
5 ATMOSPHERIC  SCIENCE 


M//51X19H*  ¥¥¥¥¥¥¥¥  *////43X,  3  6HINITI ICM 
RISE  MODULE///  55X,  UNPREPARED  0V/  46  X,  33HICM 
ASSOCIATES/  54X,  14H8EDF0R0,  MASS . //// 25X ,  ICM 


630H****  RUN  IOENTIFICAT  ION 
1/  FORMA  T( /JX, 60H THE  SPECIFIED 
INCORRECT///! 

18  FORMAT ( 1H0 ,  9X,  89HPARTICLE 
1FORM  BY  THE  USER  (DIAMETERS 
20X, 

20X  * 


3  X  *  12A6) 
MEAN  PARTICLE  SIZE 


19 

20 


FORMAT ( 
FORMAT ( 
1  E12.5, 
24  FORMAT ( 
125X32HA 


SIZE  DISTRIBUTION 
ARE  IN  METERS)) 
24HFALLCUT  PARTICLE  DENSITY*  21X, 
23HSCALEC  HEIGHTS  OF  BURST,  3BX, 


ICM 

IS  NEGATIVE  HENCE  IICM 

ICH 

SUPPLIED  IN  TABULAR  ICM 

ICM 

E12.5,  AH  KG/M,»*3)  ICM 
E12.5,  7H  FEET  (,  ICM 
8H  HETERS) )  ICM 

/20X,  38HPART ICLE  VOLUME  FRE CUENCY  DISTRIBUTION/ICM 

LOG-NORMAL  DISTRIBUTION  KITH  -/ 30X ,  16HHEC I  AN  DIAMETER,  20  X,  ICM 
2E12.5,2X,UHHICROMETERS/ J0X,28HG£DMETRIC  STANDARC  DEVIATION,  7X,  ICM 
3E12.5)  ICM 

25  FORMAT ( 1H0 9X, 65HPA RT ICLE  SIZE  -  MASS  DISTRIBUTION  TABLE  (OIAMETERSICM 

1  ARE  IN  METERS))  ICM 

26  FORMAT ( /22X77H****  IHE  CONTROL  VARIABLE  ARRAY,  IC(J),  MAS  GIVEN  TICM 

1HE  FOLLOWING  VALUES  ****/  19X,  2014)  ICM 

27  FORMA T ( /20 X ,  36HPA  FTICLE  MASS  FREQUENCY  DISTRIBUTION/  25X,  31HA  POICM 

1 WER-LAW  OISTRIBUTICN  WITH  -/  30X,  15HK-TO-MASS  RATIO,  2QX,  2PE12.5ICM 
2/  30X,  21MEXP0NENT IAL  PARAMETER,  14X,  1PE12.5)  ICM 

28  FORMAT ( 1H0 ,  11X,  63HTHE  PARTICLE  DISTRIBUTION  ABOVE  IS  A  SIZE-ACTIICM 


1VITY  DISTRIBUTION) 

192  F0RMAT(//51X,19H*  ¥*¥****4  *//> 

193  FORMAT (  10X,  33HNUM8ER  OF  PARTICLE  SIZE  CLASSES  * 

1  1H 0 « 20 X ,  8H0I AMETER,  4X,13HLQWEF;  BOUNDRY,  5X, 

2  5X  ,14M UPPER  BOUNDARY/) 

194  FORM«T(12X,I3, 4(3X,E12.5) ) 

195  FORMAT ( 2Fi 0 • 0 ) 

198  FORMAT </3X,56HTME  PARTICLE  SIZE 
2ROERED///) 

1400  FORMAT! 

IN  OF  THE  TOTAL  EXPLOSION  ENERGY 
2F6.4/  20X,  51HFRACTI0N  CF  THIS 

3F6.4/  2QX ,  37HFRACTI0N  USED  TO 


15/ 

8HFRACT ION, 


ICM 
ICM 
ICM 
ICM 
ICM 
ICM 
ICM 

DISTRIBUTION  T  A6 LE  IS  IMPROPERLY  OICM 

ICM 

20 X  ,  73HFRACT  JOICM 
IN  THE  CLOUD  AT  THE  INITIAL  TIME  =ICM 
ENERGY  USED  TO  HEAT  AIR  ANQ  SOIL  =ICM 
HEAT  LIQUID  WATER  =F6.4/  ICM 


4  2  0  X  , 

5IFICATION  TEMPERATURE  =  F8.3,  4H  (K>> 

1700  FORMAT ( 1HQ 19X3  OHCLOU  t  SUBDIVISION  PARAMETERS  -/ 

1  CLOUD  SUBDIVISIONS  I*'  THE  VERTICAL  (KOI)  =14/ 
2IZONTAL  SUBDIVISION  PARAMETER  CIRAO)  =14) 

1800  FORMAT ( 


37HFALLUUT  SOLIDICM 
ICM 

23X,  52HNUMBER  OFICM 
23 X,  46H PARCEL  HORICM 

ICM 

ICM 


12DX22H0ET0NATI0N 

244X,3(E13,6,3X)t 


COOROI NATES, 10X, 3HXGZ, 13 X, 3HY GZ  ,  13X, 3HTGZ/ 


ICM 
ICM 
ICM 
ICM 


61 

62 

63 

64 

65 
06 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

a  o 
81 
82 
S3 
64 

85 

86 
67 
88 
69 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
1J0 
101 
1C  2 

103 

104 
1)5 
106 
107 


READ  RUN  IOENTIFIER 
READ  ( I  SIN, 1) DET ID 
C  READ  CONTROL  PARAMETERS 

READ ( ISIN, 10)  IC 
C 

C  WRITE  OVERALL  TITLE 

WRITE  (IS0UT,16)DETID 
WRITE (ISOUT, 26)  IC 
C  READ  IN  BASIC  DATA 


RFADdSIN, 

JIM , 

FW, 

HEIGHT, 

ZBRSTZ, 

SLDTMF 

,  PHI 

IF ( SLOTMP 

.EQ. 

0.0 

.  ANO. 

IC<2)  . 

EQ.  Q) 

SLOTM  P=  2200 

IF ( SLOTMP 

.EQ. 

0.0 

.AND. 

IC (2 )  . 

EQ.  1) 

SL  OTM  P  =  28  00 

ICM  108 
ICM  109 
ICM  IIP 
ICM  ill 
ICM  112 
ICM  113 
ICM  114 
ICM  115 
ICM  116 
ICM  117 
ICM  118 
ICM  119 
ICM  120 


61 


oo  ooo  ooo 


40  IF (SLOTMP  .LE.  0.0)  CALL  ERR0R( PROGRM,  -40,  ISOUT) 

IF(PHI  .EQ.  0.0)  PHIsi.O 
REAOdSIN,  10>NOSTR,KCI,  IRAO 
IF (  NOS TR  .EQ.  0  )  NDSTR=100 
IF ( KOI  .Ea.  0)  KOI=i5+ALOG(W) 

REAO(ISIN,3)XGZ,YGZ»TGZ 

IF(IC(1)-1)210,220,230 

C  210  A  LOGNORMAL  PARTICLE  DISTRIBUTION  IS  SPECIFIED 
210  REAOdSIN, 3)  DNS,  OMEAN  •  SO 
C  IS  A  LOGNORMAL  DISTRIBUTION  SPECIFIED  BY  THE  USER 

IS=0 

IF ( DMEAN.GT •  0.0)  IS=i 
GO  TO  23 

C  220  A  POWER-LAW  PARTICLE  DISTRIBUTION  IS  SPECIFIED 
220  REAOdSIN, 3)0NS,  CAYN,  EXPO 
GO  TO  23 

C  230  A  TABULAR  PARTICLE  DISTRIBUTION  IS  SPECIFIED 
230  PEADdSIN,  3)DNS 

READ ( IS  IN, 19b ) (O IAM (1 ) , FM ASS ( I ) ,1*1,NDSTK) 

LD=NOSTRU 

REAOdSIN,  195)DIAM(LC) 

C 

C  CHECK  ORDERING  OF  THE  HISTOGRAM  TABLE 

DO  215  1=2, LD 

IF (DIAM (I)  .LT.  OI A M (I -1 ) )  GO  TO  215 
WRI TE (  ISOUT ,198 ) 

GO  TO  200 
215  CONTINUE 
23  HOB  =  HEIGHT/0. 3C48 

IF<  DNS  .EQ.  0.0  >  DNS  =  2.6 
RHOP=DNS*100<1. 

C  ZSCL  IS  THE  SCALED  HCB  -  COB 

ZSCL  =  HOB  /( ( W)  1.0/3. 4)  ) 

TEST  THE  SCALED  HOB  TO  DETERMINE  IF  SUBSURFACE,  LOW  AIRBURST 
OR  PURE  AIRBURST 

IF ( ZSCL+20 . 0  .LT,  0.0)  GO  TO  143 
IF ( ZSCL  .LT.  180.0)  GO  TO  70 
CALL  AIRBRS 
GO  TO  55 
70  CALI.  TIMEE 
CALL  TEMP 
CALL  MASS 
CALL  VAPOR 
IFtIC(l)-l)90,95,95 

TEST  FOR  ACCEPTABLE  SPECIFICATIONS  OF  LOGNORMAL  FARTICLE  SIZE 
DISTRIBUTION 

90  IF ( SO ) 9 1 ,92 , 9  2 

91  WRITE  (ISOUT, 2) 

GO  TO  200 

92  IF(0MEAN>94,95,95 

94  WRITE  (ISOUT, 17) 

GO  TO  200 

COMPUTE  PARTICLE  SIZE-VOLUME  (MASS)  FREQUENCY  FIST OGR AM 

95  CALL  OSTBN 

SSAM  =  SSAM  -  VPP 

C  PRINT  INITIAL  CONDITIONS  RESULTS 

WRITE (ISOUT, 4) W,FW,  FEIG HT , HOB , ZBRST  Z 

62 


ICM  121 
ICM  122 
ICM  123 
ICM  124 
ICM  125 
ICM  126 
ICM  127 
ICM  126 
ICM  129 
ICM  130 
ICM  131 
ICM  132 
ICM  133 
ICM  134 
ICM  135 
ICM  136 
ICM  137 
ICM  136 
ICM  139 
ICM  140 
ICM  141 
ICM  142 
ICM  143 
ICM  144 
ICM  145 
ICM  146 
ICM  147 
ICM  148 
ICM  149 
ICM  150 
ICM  151 
ICM  152 
ICM  153 
ICM  154 
ICM  155 
ICM  156 
ICM  157 
ICM  158 
ICM  159 
ICM  160 
ICM  161 
ICM  162 
ICM  163 
ICM  164 
ICM  165 
ICM  166 
ICM  1 67 
ICM  168 
ICM  169 
ICM  170 
ICM  171 
ICM  172 
ICM  173 
ICM  174 
ICM  175 
ICM  176 
ICM  177 
ICM  178 
ICM  179 
ICM  160 


o  o  o 


IF<  ZSCL  .LT.  180.  >  IF  ( IC  (  2)  >  301, 30 1,  3Q2 
WRITE ( I  SCUT, 121 

WRITE(  ISOUT,  ,14  )  THE,  TMPG ,  SSAM 
GO  TO  118 

3C1  WRITE  (ISOUT, 5) 

GO  TO  108 

3C2  WRITE  (ISOUT, 6) 

106  WRITE(IS0UT»13)TME,TMPG»TMPS»VPR»SSAM 
118  ZSCM=ZSCL*0,3048 

WRITE (ISOUT, 20 >ZSCL,ZSCM 

C  SET  FRACTION  OF  EXPLOSION  ENERGY  IN  THE  CLOUD 
F=  •  45 

RPHIal. (1-PHI 

WRITE (I SOUT, 1400)  F ,PHI, RPHI, SLDTMP 
WRITE (ISOUT, 18 00  »XGZ,Y  CZ,TGZ 
WRITE (I SOUT ,191  RHOF 
IF  ( IC  (1 )  -1) 309, 310 ,311 

309  WRITE(ISOUT,7)DMEAN,SD 
IF  (IS) 102, 1U3, 102 

103  WRITE  (ISOUT, 8) 

GO  TO  105 

102  WRITE  < ISOUT, 9) 

105  9ARHU  =  £XP(ALOG(OMEAN)  ♦  3 .ANALOG (SO) +*2) 

WRITE( ISOUT ,24) BAR  HU » SO 
WRITE  < I SOUT ,258 
GO  TO  315 

310  WRITE (ISOUT ,27)  CAYM  ,  EXPO 
GO  TO  315 

311  WRITE (ISOUT ,18) 

PRINT  PARTICLE  SIZE  DISTRIBUTION  TABLE 

315  WRITE (IS OUT ,193)N0STR 
OO  602  J=1 , NOSTR 

602  WRITE  (I  SOUT,  194)  J , P S ( J > , OI AM ( J*i > , FMASS < J)  ,OIAH(J» 

C  CHECK  IF  PARTICLE  DISTRIBUTION  IS  OF  THE  SI ZE- ACTIWIT Y  TYPE 
IF  ( IC  ( 5 )  .EC.  0)  GO  TO  603 
SD  =  -1  •  0 

WRITE (IS OUT, 28) 

603  WRITE(ISOUT»1700)KCI,IRAD 
WRITE (ISOUT ,192) 

200  WRITE (ISOUT ,15) 

RETURN 

143  WRITE  ( ISO  LT, 11 ) 

GO  TO  200 
ENO 


ICN  161 
ICM  182 
ICM  183 
ICM  184 
ICM  165 
ICM  186 
ICM  167 
ICM  188 
ICM  189 
ICM  190 
ICM  191 
ICM  192 
ICM  193 
ICM  194 
ICM  195 
ICM  196 
ICM  197 
ICM  198 
ICM  199 
ICM  200 
ICM  201 
ICM  202 
ICM  203 
ICM  204 
ICM  205 
ICM  206 
ICM  207 
ICM  208 
ICM  209 
ICM  210 
ICM  211 
ICM  212 
ICM  213 
ICM  214 
ICM  215 
ICM  216 
ICM  217 
ICM  2.18 
ICM  219 
ICM  220 
ICM  221 
ICM  222 
ICM  223 
ICM  224 
ICM  225 
ICM  226 
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*QECK,  AIRBRS  AIKBR  1 

SUBROUTINE  AIRBRS  AIRBR  2 

AIRBR  3 

H.  G.  NORM  ENT  t  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER,  1978  AIRBR  4 

AIRBR  5 

«**»¥#»«.*«*«#*********««*  «*«*.»****¥«*********#**»¥*«*•  +  ****  +  £ 

AIRBR  7 

COMBINES  FUNCTIONS  OF  SUBROUTINES  TIME,  TEMP,  MASS,  AND  VAPOR  AIRBR  8 

FOR  AN  A1RBURST.  ALSO  SETS  LOGNORMAL  CEeRlS  P AFTICLE  SIZE  AIRBR  9 

OISTRIBUTION  PARAMETERS  FOR  AN  AIRBURST.  A  GEOMETRIC  STANDARD  AIRBR  10 

DEVIATION  OF  2.0  IS  ASSUMED.  THE  MEOIAN  PARTICLE  DIAMETER  MAS  AIRBR  11 

COMPUTED  FROM  EQS.  (A3)  ANO  (44)  OF  NATHANS, ET  AL. ,  JGR75 ,  7565  AIRBR  12 

(197.1)  (FOR  BROWNIAN  MOTION)  AIRBR  13 

AIRBR  14 

*«*#*«*  44  ¥*♦¥*♦*  ** ft  I RBR  15 

AIRBR  16 

COMMON  /BASIC/  H, FW , ZBRSTZ , HEIGHT, ZSCL , SLDTMP, T MSD ,XGZ ,Y GZ , T GZ  AIRBR  17 
COMMON  /CONTRL/  CETIO (12 ) , IC ( 20 > ,IRA D, IRI SE , IS  IN  ,1 SOUT , JP ARN  ,KDI  AIRBR  16 
COMMON  /INITL/  F,  PHI,  SSAM,  TME,  TMPG ,  TMPS,  VPR  AIRBR  19 

COMMON  /PARTCL/  NOS TR, RH CP , OME AN, SD, PS ( 26 0 > ,UI AM (201 ) , FM ASS (200 )  AIRBR  20 

AIRBR  21 

*«»»*****#**»****»***#«««* ****+«*#********»«**»»*v »«*****+*»****¥*«* «»axK3K  22 

AIRBR  23 

SET  TIME  OF  THE  SECOND  THERMAL  MAXIMUM  AND  THE  DELFIC  INITIAL  AIRBR  24 


TIME  (SEC) 

T2M  =  0.Q45 
TME  =  56.  * 


*  H**(0.A2) 

T2M  *  W*M-0.30) 


SET  INITIAL  CLOUD  TEMPERATURE 

A  =  6647.  ♦  W**(-0.013i> 

B  =  -0.  4473  *  W*MQ  .0436) 

TMPG  =  A  *  (TME  /  T2M)**8  ♦  150  0  . 

TMPS  =  TMPG 

SET  MASS  OF  CONDENSEC  PHASE  MATERIAL  IN  THE  CLOLC  (KG) 
SSAM  =  9).  718 
VPR  =  0.0 

IF ( IQ  11 )  ,NE.  0  .OR.  CMEAN  .NE.  0.0)  RETURN 

SET  DE9RIS  FARTICLE  SIZE  OISTRIBUTION  PARAMETERS 

SO  =  2. 0 
OME AN  =  0. 15 
RETURN 
END 


AIRBR  24 
AIRBR  25 
AIRBR  26 
AIRBR  27 
AIkBR  28 
AIRBR  29 
AIRBR  30 
AIkBR  31 
AIRBR  32 
AIRBR  33 
AIRBR  34 
AIRBR  35 
AIRBR  36 
AIRBR  37 
AIRBR  36 
AIRBR  39 
AIRBR  40 
AIRBR  41 
AIKBR  42 
AIRBR  43 
AIRBR  44 
AIRBR  45 
AIRBR  46 
AIKBR  47 
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*0ECK,0ST3N  DSTBN 

SUBROUTINE  OSTBN  DSTBN 

DSTBN 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  DSTBN 

DSTBN 

«»**#****«»#  w*#4#«***«***e*4«*#**«***  ****»»*»♦*** 

DST8N 

SETS  UP  HISTOGRAM  TABLES  OF  PARTICLE  MASS  AS  A  FUNCTION  OF  ASTBN 

PARTICLE  DIAMETER.  DSTBN 

OSTBN 

LOGNORMAL  DISTRIBUTION  TO  100  OSTBN 

POWER  FUNCTION  DISTRIBUTION  TO  200  OSTBN 

TABULAR  DISTRIBUTION  TO  300  OSTBN 

DSTBN 

EQUATION  2 6.2.23  OF  MBS- AMS  55  HANDBOOK  IS  USED  TO  COMPUTE  THE  OSTBN 
PROBABILITY  FUNCTION  ARGUMENT  FRCM  THE  RATIONAL  FOLYNOMIAL  OSTBN 

APPROXIMATION  TO  THE  NORMAL  PROBABILITY  FUNCTION.  OSTBN 

DSTBN 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 


COMMON  /CONTRL/  GET  IQ ( 12 ) , I C < 20 > , IRA D , 
COMMON  /INITL/  F,  PHI,  SSAM,  TME ,  TMPG 
COMMON  /PARTCL/  NOSTR ,RI  I  CP, DMEAN , SO, PS 
EQUIVALENCE  (DMEAN, CAYM) , <SD,EXPC) 

DATA  PROGRM,  PI/  6HCSTBN  ,  3.141592654 


> ******** 

IRISE.IS 
,  TMPS , 
(200), DI 


************************************************** 
TA(X)=SQRT (ALOGC1. 0/X**2) ) 

APX(X)  =  TA(  X)-(  2.  515517+0.83  2853MACX)Mu.010  328 
1 <1.0  Ml.  432 7  86* TA (X)  +0 .1 8 9269*TA ( X) ** 2* l . C 0 13 1 6 


*******»pSTg;] 

DSTBN 

IN,ISOUT»JPARN,KDI  DSTBN 
VFR  DSTBN 

AM(201),FMAsS(200)  DSTBN 

OSTBN 

D5T8N 

DSTBN 

************** ****¥*QgygN 

DSTBN 


*T  A( X ) **2 )  / 
*TA(X>**3> 


OSTBN 

DSTBN 

DSTBN 

DSTBN 


19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 
3  0 

31 

32 


IF(IC(1)-1) 100,200, 300 

DSTBN 

34 

100 

IF (DMEAN)111,111,112 

DSTBN 

35 

111 

DME  AN=0 . 40  7 

DSTBN 

36 

SO=  4.0 

OSTBN 

37 

112 

IF ( NQSTR-1) 101,101, 102 

OSTBN 

38 

101 

PS(1.»  =0HEAN*1.0E-6 

OSTBN 

39 

C5=SD**5 

OSTBN 

40 

DIAM(i) =DMEAN*C5*1. 0E- C 

DSTBN 

41 

OI A  M ( 2) =0MEAN/C5*1. QE-6 

DSTBN 

4  2 

FMA  SS ( 1 ) =1 . 0 

DST  BN 

43 

GO  TO  400 

DSTBN 

44 

It  2 

BARMU=ALOG (ORE  AN) 

DSTBN 

45 

SIGMA=ALOG (SO ) 

DSTBN 

h6 

BARMU=3ARMU«-3.*SIGMA**2 

DSTBN 

4  7 

FRA  0=1. 0/FLOAT(NOSTR ) 

DSTBN 

*40 

DO  103  NQ= l,NOSTP 

OSTBN 

45 

103 

FMA  SS ( NO )=  FRAC 

OSTBN 

50 

NH=  NO  ST  R/2 

DSTBN 

51 

DO  104  1=1, NH 

DSTBN 

52 

PRB=FLOAT(I)*FRAC 

DSTBN 

5  5 

OIAM(I  +  i)  =  BARMU«-APX  (FRB)  *S  IGMA 

OSTBN 

54 

J=NOSTR-I+ 1 

DSTBN 

55 

104 

HI  AM ( J) =  BARMU-AP  X(PRH)*SIGMA 

DSTBN 

66 

OSTBN 

5  7 

FOR  THE  2  EXTREME  INTERVALS  THE  AVERAGE  DIAMETER  IS 

DSTBN 

58 

ASSUMED  TO  BE  AT  HALF  A  MASS  FRACTION  FRCM  ZERO  AND  ONE 

DSTBN 

69 

D  S  T  S  N 

6ij 

65 


o  o  c 


PRB=FRAC  2.0 

PS ( 1) =B ARMU+6PX  <  PR8 )  *SIGHA 
PS ( NDSTR )=BARMU-APX  (FR8) ♦SIGMA 
OIAM(l) =2.*PS<1) -0  I AM2  ) 

OIAM(LD )=2.*PS(NOSTft)-DIAM (NDSTR) 

CALCULATE  MEAN  01 AMETERS  FROM  BOUNDARY  VALUES 

J=NOSTR-i 

IF(J-l) 107,107,105 
1C  5  00  106  1=2, J 

106  PSCI)=0 .5* (DIAM( II ♦ C 3AM ( 1*1) ) 

1C  7  00  108  1=1  , NDSTR 

OIAM(I) =EXP(DIAM(I> >  *1.0E-6 
106  PS(I)=EXP(PS(I)I*1. OE-fe 

OIAM(LO)=EXP(DIAM(LC))  *i.0E-6 
GO  TO  400 

200  IF ( EXPO  .  DE.  4.0)  CALL  ERROR( PROGRM,  -200,  ISOUT) 
AN=FLOAT(NOSTR) 

FRAC=1. 0/AN 
00  205  1=1 , NDSTR 
205  FMASS ( I ) =FRAC 

P0H=1. 0/(4. C- EXPO) 

DMIN  =  (6. J'FRAC/(PI*RHOF*CAYM*PQW>> ♦♦POK 
DO  206  IJ=1, NDSTR 
AJ=I J-l 

20  6  DIAMUv,:  -'7N-AJ)  **pcw*omin 
PS ( NDSTR ) =DMI N* 0 .5**FOW 
OIAM(LO)=PS(NOSTR)*4Z/OIAM(NOSTR) 

NO=  NOSTR-1 
00  207  I J= 1 ,ND 

20  7  PSCIJJ=SG(Rr<OIAM(IJ)  »OIAM(IJ*i)  ) 

00  TO  400 

300  00  301  1=1, NDSTR 

3C1  PS(I)=SQRT  (DIAM1 15  *0  1AM(  1+ 1) )  *1.  Q.E-6 
DO  30e  IJ=l,LO 

308  OIAM(j;.J)=1.0E-6*OIAM(IJ) 

400  RETURN 
ENO 


DST8N  61 
OSTBN  62 
DSTBN  63 
DSTBN  64 
OSTBN  65 
OSTBN  66 
DSTBN  67 
DSTBN  be 
DSTBN  69 
DSTBN  70 
DSTBN  71 
DSTBN  72 
OSTBN  73 
DSTBN  74 
OSTBN  75 
OSTBN  76 
OSTBN  77 
DSTBN  76 
OSTBN  79 
DSTBN  80 
OSTBN  81 
OSTBN  22 
OSTBN  63 
DSTBN  84 
DSTBN  85 
DSTBN  66 
DSTBN  67 
DSTBN  88 
OSTBN  89 
OSTBN  90 
DSTBN  91 
OSTBN  92 
OSTBN  93 
OSTBN  94 
DSTBN  95 
DSTBN  96 
DSTBN  97 
OSTBN  98 
DSTBN  99 
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*QECK»  MASS  MASS 

SUBROUTINE  MASS  MASS 

MASS 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  197€  MASS 

MASS 

*»«# *>**#**# ***************** ** ******  ♦***#**♦♦*»*♦#*♦*■**♦*♦*■**#***♦*+*#»■  ^^  ss 

MASS 

ESTIMATES  MASS  OF  FALLOUT  IN  THE  FIREBALL  FCR  A  SURFACE,  LOW  MASS 

AIR3URST  OR  SHALLOW  JUBSLRFACE  BURST.  MASS 

MASS 

*»*»****«*»  ***•*****«.»#*«***#  V.#*,******  *****  #4  *«»  *****  ***********  **MASS 

MASS 

COMMON  /BASIC/  H ,FW , 28RSTZ , HEIGHT, ZSCL , SL OTMP, TM SO , XGZ , YGZ, T GZ  MASS 

COMMON  /INITL/  F,  PHI,  SSAM,  THE,  TMPG ,  IMPS,  VPR  MASS 

MASS 

************************************************«**Q********* *********  MASS 

MASS 

HOB  OR  DOB  MASS 

IF(HEIGHT) 230,240,240  MASS 

230  0=2.181595  MASS 

Q=-ZSCL  MASS 

R=l.i25E  +  0  2  +  <7.55E-ai)*CI-(9.6E-0b)*<Q**3.0>-(9 .1  IE-12)  *<Q**5.0)  MASS 

S=3.27E*01+<8.51E-01)*Q-(2.52E-05) *t Q** 3 . J ) ♦ (1 . 78E-1 C) *<Q**5.0>  MASS 

SSAM=  D*({W)**(3.Q/3.4))MR**2.Q)*S  MASS 

GO  TO  250  MASS 

240  E=Q. 07740685  MASS 

SSAM=£*{(WJ*M3.C/3.4))¥((18i!.0-ZSGL)**2.Q)*<36C.O*ZSCL>  MASS 

250  RETURN  MASS 

END  MASS 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 


DECK, VAPOR 

SUBROUTINE  VAPOR 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978 


VAPOR  1 
VAPOR  2 
VAPOR  3 
VAPOR  4 
VAPOR  5 

QR  g 

VAPOR  7 

ESTIMATES  PORT IO  N  CF  FALLOUT  MASS  (CALC.  BY  SR  PASS)  IN  THE  VAPOR  8 

VAPOR  STATE  AT  THE  INITIAL  TIME  VAPOR  9 

VAPOR  10 

********  ***************************  ********  *********  **  *****  *********  **VA  POR  11 

VAPOR  12 

COMMON  /BASIC/  W ,FW  , Z8RSTZ , HEIGHT , ZSCL , S LOTMP, TMSD , XGZ , YGZ , TGZ  VAPOR  13 

COMMON  /CONTRL/  OE TIO C12 ) , I C < 2 0 > , IRA 0, IRISE , IS  I N ,1 SOUT , JPARN  ,KDI  VAPOR  14 
COMMON  /INITL/  F,  PHI,  SSAM,  TME,  TMPG,  TMPS,  VFR  VAPOR  15 

VAPOR  16 

***********  ***  *****************  ************  *******  *************** ****»yAPOR 

VAPOR  18 

BRANCH  ON  THE  BASIS  CF  SOIL  CATEGORY  -SILICEOUS  TO  100, 

CALCAREOUS  TO  20C 
IF<ICC2)liJfl,100,200 


IOC 

110 


IS  THE  COMPUTED  VAPOR  TEMPERATURE  HIGHER  THAN  THE  SILICEOUS  SOIL 
BOILING  TEMPERATURE 
IF(TMPG -3000.0)120  ,120  ,110 
VPR=SSA  M*0. 00C  15*  (TMPG-3  0  00.0 


VAPOR  19 
VAPOR  20 
VAPOR  21 
VAPOR  22 
VAPOR  23 
VAPOR  24 
VAPOR  25 
VAPOR  26 
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GO  TO  130 

VAPOR 

27 

c 

VAPOR 

28 

c 

IS  THE  COMPUTED  VAPCR  TEMPERATURE 

HIGHER  THAN  THE  CALCAREOUS  SOIL  VAPOR 

29 

c 

BOILING  TEMPERATURE 

VAPOR 

30 

200 

IF (TMPG-3100.0)120, 120*115 

VAPOR 

31 

115 

VPR=SSAM*0. 0 CO  15*  STMFG-3  10 0 .01 

VAPOR 

32 

GO  TO  130 

VAPOR 

33 

120 

VPR='.C 

VAPOR 

34 

13C 

RETURN 

VAPOR 

35 

END 

VAPOR 

36 

*1 

DECK,  TEMP 

TEMP 

1 

SUBROUTINE  TEMP 

TEMP 

2 

C 

TEMP 

3 

c 

H,  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1076 

TEMP 

4 

C 

TEMP 

5 

C 

44*44444*-*-t*-44*444*444*4444444*#-t  +  **»4444¥*4*44444*4*4*4#*4*444**¥-  +  ¥4»X£HP 

6 

c 

TEMP 

i 

c 

ESTIMATES  TEMPERATURES  OF  CONDENSED  AND  VAPOR  PHASE  FALLOUT  IN 

TEMP 

8 

c 

THE  FIREBALL  AT  THE  INITIAL  TIME, 

TEMP 

9 

C 

TEMP 

10 

c 

**TEMP 

11 

c 

TEMP 

12 

COMMON  /BASIC/  W , FW  ,  ZBRSTZ , HE  I GHT , ZS CL , SL DTMF ,  TMSD  ,  X GZ , Y GZ , T GZ 

TEMP 

13 

COMMON  /INITL/  F,  PHI,  SSAM,  TME,  TMPG,  TMPS,  VFK 

TEMP 

14 

c 

TEMP 

15 

c 

4444*4+4 4 4*^ *4444*4444444 44 *+444***4*4*44444*444 44 4444444 *4 ***♦  44***  *4  MP 

16 

c 

TEMP 

17 

c 

COMPUTE  VAPOR  TEMPERATURE 

TEMP 

18 

Q=ZSCL*W** (-. 03921) 

TEMP 

19 

T  2  M  =  T  .  3  37*  (  (C.  0  4  5/0  .  037  >  *MQ/18Q  .  ))*  ( W* * ( 0  , 49- ( 0 .0 7*0/  180  .  >  ) ) 

TEMP 

20 

A=598  0.  *  ( (  1.145)**  (Q/180  .  )  )  ♦  <  <  W  )  **  <-  0.  0  39*8  n.  J  2  63  7*0/  180,0  )) 

TEMP 

21 

B=-0.4473MW**(G  .0  4360)  ) 

TEMP 

22 

TMPG=A* ( (TME/T2M)**e>Tl500.0 

TEMP 

23 

c 

TEMP 

24 

c 

COMPUTE  TEMPERATURE  OF  CONDENSED  °HASE  MATTER 

TEMP 

25 

TMPS  =  200.  *  ALOGlOiW)  ♦  1000. 

TEMP 

26 

RETURN 

TEMP 

27 

ENO 

TEMP 

20 

OOOOOOOOOOOOOOOOOOOO  *  OOO  OOOOOOOOOO 


♦DECK, TIMEE  TIMEE  1 

SUBROUTINE  TIMES  TIMfcE  2 

TIMEE  3 

H.  6.  NORNENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  TIMEE  A 

TIMEE  5 

¥¥¥*¥¥*¥¥¥¥¥¥**¥*¥¥¥¥¥¥*¥*¥¥¥¥+¥»¥¥  *¥¥+¥¥¥¥¥¥**¥*#***¥¥*'.'¥¥*¥  ¥¥¥¥¥¥¥¥¥  f  I  MEE  6 

TIMEE  7 

SETS  TIME  (RELATIVE  TO  DETONATION)  OF  THE  INITIAL  CONDITIONS  TIMEE  6 

SPECIFICATIONS  TIMEE  9 

TIMEE  16 

¥■*  «¥¥¥¥*¥*¥¥¥¥¥¥*¥¥*¥*«¥¥¥*¥¥¥*¥¥¥¥  +  ¥»**¥*  ¥¥*♦¥¥¥¥¥¥¥¥¥¥♦♦*¥¥*¥¥¥»¥¥¥»  J  £  |  ^ 

TIMEE  12 

COMMON  /BASIC/  M ,  Fh  ,  2BRS  1 Z  ,  HEIGHT  ,  ZSCL  ,  SLO  TMF ,  TMSQ  ,X  C-Z  ,Y  G2 ,  T  GZ  TIMEE  13 

COMMON  /INITL/  F,  Phi,  SSAM,  TME,  TMPG ,  TMFS,  VFR  TIMEE  14 

TIMEE  15 

¥¥¥¥¥<.¥¥¥¥¥¥¥¥¥¥¥¥¥¥*¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥¥  r>  ¥¥¥¥¥¥¥«¥¥¥¥¥¥¥¥¥¥¥  ¥¥¥¥¥¥¥¥¥¥¥¥¥'|'X^g;£  ^6 

TIMEE  17 

Q=ZSCL*  W**(-.0  3*32i)  TIMEE  16 

T2M  =  !), 0 37* ( (('.04  5/0.037)  -»*(Q/18  0.)  > *  (W** (  3 . 49-  (  0  .0 7*0/ ISO  . )  ))  TIMEE  19 

TME=(56.3*T2M)/(W** (£.3))  TIMEE  20 

RETURN  TIMEE  21 

ENO  TIMEE  22 


ECK, AT  MR  AT  MR 

SUBROUTINE  AT  MR  AT  MR 

ATMR 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  CECEMBER  1976  ATMR 

ATMR 

¥¥¥¥¥¥  ¥¥¥*¥**¥¥¥¥¥¥¥♦¥¥*¥¥¥¥¥¥¥¥¥¥¥¥*-,  ¥¥¥¥¥¥¥¥¥¥¥¥¥*«¥¥¥¥»¥¥¥  *¥¥*¥¥¥¥♦  ATMR 

ATMR 

ATMR  READS  IN  ATMOSPHERE  TABLES  ATMR 

ATMR 

ATMOSPHERE  TABLE  GLOSSARY-  UNITS  ARE  FOR  THE  SCALED  ENTRIES  ATMR 

ATMR 

1  ALT  -  ALTITUDE  ABCVE  MSL  (METERS)  ATMR 

2  ATP  -  TEMPERATURE  (DEGREES  KELVIN)  ATMR 

3  PRS  -  PRESSURE  (PASCALS)  ATMR 

4  RLH  -  RELATIVE  HUMIDITY  (PERCENT)  ATMR 

5  RHO  -  OENSITY  (KGM/M**3)  ATMR 

6  ETA  -  VISCOSITY  (KGM/ (M-SEC) )  ATMR 

ATMR 

K AT M= IC (4 )  IS  THE  ATM C  SPHER  OATA  PRINT  CONTROL  ATMR 

ATMR 

**¥*¥¥¥¥*¥•¥¥¥¥¥¥¥¥¥¥¥««*¥¥¥*¥¥¥¥¥¥»¥¥¥«*¥¥*¥¥¥¥¥¥¥¥*¥¥¥¥¥¥«¥¥•¥**+¥¥» ATMR 

ATMR 

COMMON  /ATMOS/  NAT,  ALT(256),  ATP(256),  PRS(256>,  PLH(256),  ATMR 

1  RHO  (256)  ,  ETA  (256)  »  NHOOC,  ZV(IOG),  VXllJv.),  VY(iJO)  ATMR 

COMMON  /CONTRL/  OE T 10 ( 12 ) , I C ( 20 ) , I RAU, IRISE , IS  I N , I SOUT , JP ARN, KOI  ATMR 
C  ATMR 

DIMENSION  FMT (12) ,SCALE(  8) , ATMSUB (6 ) , ATNZRO (6 > , ATMMAX (6 ) , AP (6 )  ATMR 

DIMENSION  ATI D ( 12 )  ATMR 

DATA  PR0GRM/6H  ATMR  /,  AL IM IT/ 9 *9 999  .  /  ATMR 

DATA  ATMSUB/-  1JQ  G., 254.65,  .  1139E6.77.  ,1.347  ,  .1  8206E-**/  AT*R 

DATA  ATMZRO/  o.0,c8P.15,.1j133E6,  77., 1.2250,. 17694E-4/,  ATM*. 

1ATM  MAX/5..  0  Ju. , 27C. 65, . 7977  9  t2,4.L,.iL2e9E-2,.l7r  37  E-u/  ATMR 

C  ATMR 
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6 

7 

8 
9 

10 

11 

12 

13 


14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 
rQ 
21 
j2 


ooo  ciooooooo  non  o  o  o  nno 


20 

FORMAT ( 2014 ) 

AT  MR 

34 

30 

FORMAT ( 12A  6) 

AT  MR 

35 

40 

FORMAT ( 6F1 0»  0 ) 

AT  MR 

36 

44 

FORMAT ( 1H1 ) 

ATMR 

37 

46 

FORMATt  20X,23HATM0SFHERE  IDENTIFICATION  -  12A6//> 

AT  MR 

38 

47 

FORMAT {  37X»10H ATMOSPHERE, 5 IX// 7X,3 HALT* 11X ,3 HATP, 11X* 3HPRS » 11X , 3 AT  MR 

39 

1HRLH,  11X,3HRHQ*11X, 3  FETA) 

ATMR 

40 

46 

FORMAT (  / ( 6<2X*E 12* 5 ) ) ) 

ATMR 

41 

ATMR 

42 

t****,^********#*,!**##*  *#** ********  ***************  ************* ***** **  AT  HR 

43 

ATMR 

44 

READ (ISIN* 30) ATIO 

ATMR 

45 

KATM  -  ICC4) 

ATMR 

46 

IF ( KATM  «GT«  0)  WRI T  E (I S  CUT  ,*,4) 

ATMR 

47 

WRITE(IS0UT,46)ATIQ 

ATMR 

48 

IGO  =  0 

ATMR 

49 

NBRNCH=1 

ATMR 

50 

HATCOR= (1.-18. /29.) / 100. 

ATMR 

51 

ATMR 

52 

READ  OBJECT-TIME  FORMAT 

ATMR 

53 

ATMR 

54 

READ(ISIN,30)FMT 

ATMR 

55 

ATMR 

56 

READ  SCALE  AND  A  CJU  STMENT  FACTORS 

ATMR 

57 

aTMR 

56 

REAOdSIN, 40)  SCALE 

ATMR 

59 

00  90  1=1,6 

ATMR 

60 

IF(SCALE(I) )90»91,90 

ATMR 

61 

91 

SCALE ( I ) =1  * 

ATMR 

62 

90 

CONTINUE 

ATMR 

63 

ATMR 

64 

READ  ATMOSPHERE  OATA  SEQUENCE  INOICIES 

ATMR 

65 

REAOIISIN, 20) N1,N2,N3,N4,N5,N6 

ATMR 

66 

ATMR 

67 

READ  ATMOSPHERE  TABLE  ENTRIES,  SEQUENCE  AND  ADJUST  THEM  TO  THE 

■ATMR 

68 

PROPER  "NITS,  AND  WHERE  APPROPRIATE  COMPUTE  THOSE  ENTRIES  NUT 

ATMR 

69 

PROVIOEO  IN  THE  INPUT.  ETA  NEEC  NOT  DE  INPUT.  EITHER  PRS  OR 

RHZATMR 

70 

(BUT  NOT  BOTH)  NEEDS  TO  BE  INPUT. 

ATMR 

71 

ATMR 

72 

1  =  0 

ATMR 

73 

100 

RE  A  0  (IS  IN,  FMT )  AP 

AT  MR 

7  4 

IF  { AP  (Nl)  .GE.  ALIMIT)  GO  TO  U5 

ATMR 

7F 

I  =  id 

ATMR 

76 

ALT  (I)= ( AP ( Ni  )  ♦ SCALE  (7) )*SCALE(1) 

ATMR 

77 

ATP  (11=  (AP(N2)  4-SCALt(8)  )*SCALE(2) 

ATMR 

78 

PRS (I)=AP(N3)*SCALE (3) 

ATMR 

79 

RLH(I)=  AP(N4)*SCALE (4) 

ATMR 

60 

RHO(I)=AP(N5)*SCALE(5> 

ATMR 

31 

ETA(I)= AP(N6)*SCALE (6) 

ATMR 

62 

ATMR 

l  3 

ARE  SUCCESSIVE  TABLE  ENTRIES  IN  ORDER  OF  INCREASING  ALTITUOE- 

ATMR 

34 

ATMR 

85 

IF(I.EQ.l)  GO  TO  70 

ATMR 

66 

IF  (ALT  (I)-ALT(I-l) )  45,45,70 

ATMR 

67 

45 

IRR0P=- 45 

ATMR 

38 

WRITE (IS OUT, 40)  ALT  (I)  ,  ALT  (1-1 ) 

ATMR 

o9 

GO  TO  130 

ATMR 

9  0 

70 

IFCETA(I)  .GT.0.0)  GC  TO  1070 

ATMR 

91 

ETA(I)=1.458E-6*ATP(I)**1.5/(llO,4*ATP(I)) 

ATMR 

92 

1070 

IFCPRS(I). GT.0.0)  GC  TO  73 

ATMR 

93 

70 


oooo  ooooooo  oooo  ooooooo 


IF(RHO(I>.GT.O.O>  GC  TO  72  ATMR 

IRR0R=-71  ATMR 

GO  TO  130  ATMR 

ES=  611  .*(277./ATPd  ))**5,13*  EXP < 25.* ( ATP < t )- 273.  )/ATP(I))  ATMR 

PRS ( I ) =  286.79*  RHO ( I )*A  TP ( I)  +ES*RLH ( I ) *WATCO R  ATMR 

GO  Tn  100  ATMR 

IF'  HO<  D.GT.O .0)  GO  TO  100  ATMR 

ES-  611.*<273./ATP<I))**5.13*  EXPi 25 .* ( ATP(I )- 273.  >/ATP(I))  ATMR 

RHO ( I )  =  <PRS(I)-ES*RLH<I)*WATCOR)/<286.79*ATP< II)  ATMR 

GO  TO  100  ATMR 

ATMR 

NAT  =  1  ATMR 

AT  HR 

DETERMINE  IF  THE  TABLE  MUST  BE  EXPANDED  TO  256  ENTRIES  ATMR 

ATMR 

IF  (  NAT  -25  6)140,111,120  ATMR 

ATMR 

THE  TABLES  DO  NOT  NEED  EXPANSION.  CHECK  TO  DETERMINE  IF  THE  ATMR 

TABLES  HAVE  THE  PROPER  BCUNORIES.  ATMR 

ATMR 

IF  <  ABS  (  ALT  <  1 1  1000  .  I.LE.i.  I  GO  TO  113  ATMR 

IRRORs-ilZ  ATMR 

GO  TO  130  ATMR 

IF  <  A  3  S ( ALT ( 256) -5 , E4).LE«5  )  .)  GO  TO  115  ATMR 

IRR0R=- 114  ATMR 

GO  TO  12*  ATMR 

ATMR 

THE  TABLES  HAVE  THE  PROPER  BCUNORIES.  CHECK  TO  CETERMINE  IF  THE  ATMR 
ALTITUDE  INTERVALS  ARE  ALL.  203  METERS.  ATMR 

ATMR 

OO  116  1-2,  <56  ATMR 

IF(A8S(ALT(II-ALT(I-1)-2C0.).GT.2.)  IF ( NBRNCH- 1)  140,140,137  ATMR 

CONTINUE  ATMR 

GO  TO  270  ATMR 

IRROR=- 120  ATMR 

CALL  FRROR(PROGRM,IRROR,  ISOUT)  ATMR 

IRF  -137  ATMR 

GO  133  ATMR 

ATMR 

THE  TABLES  NEED  EXPANSION  OR  INTERVAL  ADJUSTMENT  ATMR 

ATMR 

REWINO  IRISE  ATMR 

ATMR 

OO  THE  TABLES  BEGIN  AT  -  100  0  METERS-  ATMR 

IF  NOT  MAKE  AN  ENTRY  AT  -1330  METERS  FRON  THE  AROC  STANOARO  ATMOS. ATMR 

ATMR 

IF (ABS(ALT (1)+ 10 00 .)  .GT.  1.)  GO  TO  15C  ATMR 

ALT  Cl )  =  -100  3.  ATMR 

GO  TO  200  ATMR 

WRITE(IRISE) ATHSUB  ATMR 

IGO=IGO*i  ATMR 

ATMR 

CO  THE  TABLES  HAVE  AN  ENTRY  AT  0  METERS-  ATMR 

IF  NOT  MAKE  AN  ENTRY  AT  0  METERS  FRCM  THE  ARCC  STANDARD  ATMOS. ATMR 

ATMR 

IFIALT(l)  .LE.  O.CtDGO  TO  20  3  ATMR 

WRITE (IRISE  3ATMZRC  ATMR 

IGO=I GO  +  1  ATMR 

ATMR 

STORE  THE  INPUT  TABLES  ON  TAPE  ATMR 


OO  116  1-2,  <56 

IF(ABS(ALT(I)-ALT(I-1)-2C0.)«GT»2.)  IF ( NBRNCH- 1)  140,140,137 
CONTINUE 
GO  TO  270 
IRROR=- 120 

CALL  FRROR (PROGRM, IRROR, ISOUT) 

IRF  -137 
GO  133 

THE  TABLES  NEED  EXPANSION  OR  INTERVAL  ADJUSTMENT 
REWINO  IRISE 


ooooo  ooo  oooo 


200  DO  210  1=1, NAT 

210  WRITE (I RISE) ALT (I)  ,ATP  (I ) , P RS < I ) , RLH ( I ) ,RH0(I)  ,ETA(I) 

no  THE  TADLcS  HAVE  AN  ENTRY  AT  5 .  j  K  M  c.TERS- 

IF  NOT  MAKE  AN  ENTRY  AT  5  J ,  t,  ”  METERS  FnC)-  THE  AHCC  STANDARD 

TF<ALT(NAT  )  .GE.  5.E4)  GO  TO  220 
IF(A9S(  ALT  (NAT  )  -5t  E  A)  «LE«  50»  )GQ  TO  220 
WRITE (IRISE)ATMMAX 
NAT=NAT  +1 

INITIALIZE  FOR  THE  TABLES  EXPANSION 

220  REWIND  IRISE 
NAT=NAT  +IGO 

IF  ( NAT  -256)222,222,221 

221  IRROR=- 221 
GO  TO  130 

222  OAL  T  =20  0  • 

NA  =  1 

READ (IRISE) ALT « 1) ,ATP( 1) , PRS<1) , RLH (ID ,RHO ( 1) , ETA ( If 
Al'ALT ( 1) 

A2=ATP(1) 

A3=PRS( 1) 

A4=  RLH ( 1) 

A5=RHO(i> 

A6=ETA( 1) 

EXPAND  THE  TABLES  TO  256  ENTRIES  IN  200  METERS  INTERVALS  IN 
ALTITUDE  FROM  -1000  TO  50000  METERS  BY  LINEAR  INTERPOLATION 
FROM  THE  INPUT  TABLES 

DO  260  1=2,256 
ALT  ( I ) = ALT  (I-D+OALT 
225  IF(A1.GE#ALT(I )) GO  TO  250 

IF ( ALT  1 1 ) - Al  ,LT.  2.)  GO  TO  250 
NA=  NA  +  1 

IF ( NAT  -  NA  •  GE,  ( ) G C  TO  240 
230  IRRQR=- 230 
C-0  TO  13U 

240  READ(IRISE) A1,A2,A3,A4, A5,A6 
GO  TO  225 

250  TERP=  DALT  / ( Al- A LT ( I- 1 ) ) 

ATP(I)  =  ATP(I-1M-TERF*  (A  2- A  TP  (I- 1)) 

PRS ( I )  =  PRS  (1-1) ♦TERP*(A3-PRS (I -1) > 

•rLH  (  I )  =  r.  ,-H  ( I  - 1  >  +T  1R  c  *  (A  4-Rl  H  (I- 1  )  ) 
f  H  J  ( I  )  =  ••  H  O  ( I  - 1  )  ♦  T  F  P  p  •»{  A  5  -  R  H  U  ( I  - 1 ) ) 

"TA  (  T)  =  rTA  ( I-i  )  ♦  TERF'MA6-ET  A  ( I  —  1 )  ) 

260  CONTINUE 
NAT  =2  56 
NBR  NCH  =  2 
GO  TO  111 

270  IF(KATM  ,EQ,  0)  RETURN 
WRITE(IS0UT,47) 

WRITE (ISOUT, 46  )  (ALT  (I) , ATP (I) , PRS  C I ) , KLH (I ) ,RHC  (I )  , ETA  (  I)  , 
1  I=KATH,NAT,KATM) 

RETURN 

ENO 


AT  MR 
AT  MR 
ATMR 
AT  MR 
AT  MR 
ATMOS. ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
A  T  M  *v 
AT  C.R 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
ATMR 
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ooo  o  o  oooooooooooo 


♦OECK.SHHINO  SH  WIN 

SUBROUTINE  SHWINQ  SHWIN 

SHWIN 

H.  G.  NORHENT,  A  TMOSFHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  SHWIN 

SHWIN 

**¥¥***«***«*»«#*»*«+ »*««*«***«*+«» ***************  ««***»**********»»#»  SHWIN 

SHWIN 

READS  IN  SHOT  TIME  WIND  DATA  ABOVE  GROUNC  ZERO  SHWIN 

THESE  WINDS  ARE  USDE  TO  COMPUTE  WIND  SHEAR  EFFECTS  ON  CLOUD  RISE  SHWIN 
AND  TO  TRANSPORT  THE  CLOLO  AND  FALLOUT  WHILE  THE  CLOUD  RISES  AND  SHWIN 
STABILIZES.  SHWIN 

SHWIN 

***********  **•««**#***¥#+ v******#*#***##  *******  #*«#*»******»S^|  WIN 

SHWIN 

COMMON  /'ATMOS/  NAT,  ALT<256>,  ATP(256),  PRS(256),  RLH(256I,  SHWIN 

1  RHO (256) «  ETA (256) ,  NHOOC,  ZV(iQO),  VX(lOt),  VY(1J0>  SHWIN 

COMMON  /CONTRL/  DET 10 ( 12 ) , I C < 20 > , IRAQ , IRISE , IS  IN , I SOUT , JP A RN  ,KOI  SHWIN 

SHWIN 

INTEGER  FORM, METEOR  .RESOLV  SHWIN 

DIMENSION  SCALE<5) , AP < 3) , FMT f 12 >  SHWIN 

DATA  ALIMIT  ,  RADC  ,  PROGRM  ,  METEOR  ,  RESOLV  SHWIN 

1  /  999999.  , .  0 17  A  53292  5,  6HSHWIN0,  4HMETE  ,  4HRES0  /  SHWIN 

SHWIN 

1  FORMAT  «  2014)  SHWIN 

2  FORMAT  (  1H1 ,  37X,  1 9  PSHOT-T IME  WINO  DATA//  19X,  8H  RAW  UATA,  36X,  1SHWIN 
1 4HPROCE SSEO  DATA//  8X,  1HZ ,  9X,  10HVX  OR  DIR.,  3X,  11HVY  OR  SPEED, SHWIN 

2  14X,  1HZ,  12X,  2HVX,  12X,  2HVY / )  SHWIN 

3  FORM  AT (  3 ( 2X , lPE 12. 5  ) )  SHWIN 

<*  F0D"141(  iHt,  u  7  X ,  3 <2X,iP£i2. 5) >  L  H  W 1  n 

5  FORMAK  1H.,  9  X  .  3  9  H  £  HU  T  -  T I M  £  WINDS  HAVE  NOT  BEEN  SPECIFIED)  SHWIN 

6  FORMAT?  8F10.0)  SHWIN 

7  FORMAT (  12A6)  SHWIN 

8  FORMAT l bX,  A4)  SHWIN 

SHWIN 

***4-  *******  44*4  44 444444*4** 4* **4**4**4**4*44*  444  44  4444444444  ****♦****. JHWIN 

SHWIN 

NHOOO=0  SHWIN 

TRNS=0.  SHWIN 

COPY  IN  DATA  TYPE  INOIGATOfi  ANC  FORMAT  SHWIN 

READ (IS  IN, 8 )  FORM  SHWIN 

READ ( IS  IN, 7 )  FMT  SHWIN 

WRITE ( I SOUT , 2 )  SHWIN 

COPY  IN  WINO  OATA  SCALE  FACTORS  AND  DATA  POINTERS  SHWIN 

READ ( IS  IN, 6 )  SCALE  SHWIN 

RE AO ( IS  IN, 1 )  Nl,  N2,  N3  SHWIN 

DO  9  1=1,3  SHWIN 

9  IF (  SCALE(I)  .EQ.  0.0  )  SCALE(I)  =  1.0  SHWIN 

IF (FORM  .EQ.  METEOR)  TRNS=SCALE < 3)*SCALE (5)  -  180.  SHWIN 

COPY  IN  WINO  OATA  SHWIN 

100  READ(ISIN,FMT) AP  SHWIN 

IF(APCNl)  .GE.  ALIMIT)  GO  TO  200  SHWIN 

MHODO  =  NH00041  SHWIN 

COPY  OUT  RAW  WINO  OATA  SHWIN 

WRITE (ISOUT,3)AP (Nl )  ,  AP(N2),  AP(N3>  SHWIN 

10  IF  ( NHOOQ  .GT.  100)  CALL  ERRGRt  PROGRM,  -11),  ISCUT)  SHWIN 

COMPUTE  SCALED  WINO  OATA  SHWIN 

7  V  <  NHOD  O)  =  (  AP(N1)  «•  SC  ALE  (  4  ) )  *S  CAL  E  ( 1 )  SHWIN 

IF ( F ORM  .EQ.  RESOLV)  GO  TO  15  SHWIN 

VX(NH000)=AP(N3)*SCALE(2)*SIN(F.  A0C*<AP(N2)*SCALE(3)  +  TRNS)  )  SHWIN 

VY(NHODO)=AP<N3)*SCALE(2)*COS(P.ADC*(AP  (  N2  )  *  SCA  L  E  ( 3  )  +  TRNS))  SHWIN 
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GO  TO  50 

15  VX(NH0D0)=AP(N2)*SCALE(2) 
VY(NH0D0)=AP(N3)*SCALE(2) 

COPY  OUT  SCALED  WIND  OATA 

50  WRITE  (ISQUT,4)ZV<NHC00>,\/X(NHQ00)  , 
GO  TO  100 

2 fcO  IFINHODO  .GT.  5)  RETURN 
WRITEdSOUT  ,5) 

RETURN 

ENO 


SHWIN  61 
SHWIN  62 
SHWIN  63 
SHWIN  64 

VYiNHCDO)  SHWIN  65 

SHWIN  66 
LHWIn  1 7 
jWWIH 
SHWIN  69 
SHWIN  70 
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SUBROUTINE  CPFR  CPFR  2 

CPFR  3 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  CPFR  4 

CPFR  5 

4  4  44  4  44  4  4  44  444444444444  «¥444444444444  *4+444  ***»****«**t»****  +  »*  +  ¥»»»»HJpp^  0 

CPFR  7 

CPFR  COMPUTES  PARTICLE  FALLOUT  RATE  CPFR  8 

CPFR  9 
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CPFR  11 


COMMON 

/CLOUD/  CHANGE, CM  IR  ,C2 

»C3 

,  C6 

,  DEK  , DRM 

,  CPFR 

12 

1  OS 

, OST  , OSTO  ,OSTl  ,  0ST2 

»UT 

,  DU 

, DWT  , D  X 

,  CP  FR 

13 

2  DZ 

,EO  ,EK  ,EP  S  ,ES 

,  HLR 

,  KS 

,  KSV  ,  MW  VA 

,  CPFR 

14 

3  N 

, NNN  ,P  ,PW  , R 

,  RA 

,  RL 

,RM  , RZ  T 

.CPFR 

15 

4  S 

, SA VE  .SHAPE  , SMALLT.T 

,TE 

,U 

,V  ,  WT 

,  CPFR 

16 

5  X 

,  XE  ,Z  ,ZBFR  ,ZLMT 

.SPARE 

CPFR 

17 

COMMON 

/CONTRL/  DETIO  (12) ,IC<20) , 

I RAO, IRISE.IS IN 

,ISOUT, JPARN.KOI 

CPFR 

18 

COMMON 

/PARTCL/  NOSTR.RHCP.DMEAN, 

SD,  PS ( 200 ) , Cl  AM  (20 1 ) , FH ASS  ( 20  0  ) 

CPFR 

19 

COMMON 

/TABLES/  MCX,  CX(50,1C),  GOPSTdJ, 

100) 

CPFR 

20 

CPFR 

21 

DIMENSION  Y (200  ) ,CG  (200  ) 

CPFR 

22 

EQUIVALENCE  (Y (1 ) , GCPST (1) > ,  (CG (1 ), GOPST (2 01) ) 

CPFR 

23 

CPFR 

24 

903  FORMAT 

(1H1////////// 

CPFR 

25 

1  20X30HNEGATIVE  PARTICLE  DENSITY 

/////  ) 

CPFR 

26 

756  FORMAT( 1H124X73M*  ¥¥¥44444 

♦  #  *  4 

4  #  * 

CPFR 

27 

1*  **********  *//  22X  *  76HP  ART ICLE  SETTLING  RATES  ARE  INACPFR  28 

2CCURATE •  DAVIES  NUMEER  IS  TOO  LARGE  FOR  THE  13,  8H  TH  SIZE//  24X,CPFR  29 

3  73H*  4¥¥¥¥4¥¥¥¥4*44¥¥  +  +  ¥¥4*4*4¥¥444  QPFR  30 

4*  *  *  *  *  *///>  CPFR  31 

CPFR  32 
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CPFR  34 

TEST  FOR  IMPOSSIBLE  PARTICLE  CPFR  35 


DO  9:i  J=1*NDSTR 

IF  <Y<  Jl)  9G2,  9  1,  9  x 
:i  no*'TlNU' 

GO  TO  S' 

9  .!  2  WRITEdSOUT,  -  03) 

MW Y  A  =  3 
GO  TO  008 

00  CONTINUE 

COMPUTE  PARTICLE  FALLOUT  RATES 


CPFR  35 
CpFi<  '6 
CPF-  37 
CPFR  3o 
opFR  39 
CPFR  4U 
CPFR  41 
CPFR  42 
CPFR  43 
CPFR  44 
CPFR  45 
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CPFR 

46 

VIS=1.4  58F-6*T**i„  5/(1 10.4+T) 

CPFR 

47 

00  3  Js l»NO  STR 

CPFR 

48 

CALL  SETTLE (PS(J),  fi FCF*  RA,  VIS,  T,  P,  CG(J),  IACCR) 

CPFR 

49 

IF ( MWYA  . £Q.  1  .ANC. 

IACCR  .NE.  0)  WRITEdSCUT  ,75 8)  J 

CPFR 

50 

CONTINUE 

CPFR 

51 

CPFR 

52 

COMPUTE  OVERALL  LOSS 

RATE  OF  FALLOUT  FROM  THE  CLOUO  AND  ADJUST 

CPFR 

53 

IN-CLOUO  PARTICLE  CONCENTRATIONS 

CPFR 

54 

CPFR 

55 

CMLR=  0 • 

CPFR 

56 

A=  3. 1 41 5 92 7 +R#* 2*0 ST 

CPFR 

57 

00  1  J=1,N0STR 

CPFR 

58 

C=0.5235988*PS  <J)**3 

CPFR 

59 

D=A*CG( J) 

CPFR 

60 

CHLR=CMLR*C*0*Y ( J) 

CPFR 

61 

Y(J)=Y(J)*(l.-0/V) 

CPFR 

62 

CMLR=CMLK*RHOP/OST 

CPFR 

63 

RETURN 

CPFR 

64 

END 

CPFR 

65 

CRM 
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1 

SUBROUTINE  CRM 

CRM 

2 

CRM 

3 
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CRM  5 
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CRM  7 

COMPUTE  THE  DYNAMIC  CLOUD  RISE  CRM  8 

CRM  9 

THIS  COQE  CLOSELY  FOLLOWS  THAT  OF  HUEB5CH,  'THE  DEVELOPMENT  OF  A  CRM  10 

MATE '-uU?FACb-BURST  FALLOUT  »00£L  -  TH  f-  ISt  A-0  -.XT-ANjIUN  OF  T  H 1  CRF  11 

ATOMIC  OlOUO*  ♦USNRCL-TR-74.  (2o  l  .^4),  4NL  '  TUr 'MJL_NCc. ,  uRM  12 

TO?O.IjAL  c ircu  lat i c  n  and  dispersion  of  fallout  FFOM  THE  Rising  CRM  13 

NUCLEAR  CLOUD*,  USNRDL-TR10  54  (5  AUGUST  1966).  THE  HUE0SCH  MODEL  CRM  14 

HAS  3EEN  MODIFIED  AS  DESCRIBED  BY  NORMENT,  'VALIDATION  AND  CRM  10 

REFINEMENT  OF  THE  DELFIC  CLOUD  RISE  MOOULES  DNA  4  320F 11 5  JAN1977  I  CRM  16 

CRM  17 
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CRM 

19 

COMMON 

/CLOUD/  CHANGE 

,CMLR 

,C2 

,C3 

,C6 

,  DEK 

,DRM 

,  CRM 

20 

1  OS 

,DST  , OSTO 

,0ST1 

,  0ST2 

,OT 

,OU 

,  DWT 

,  0  X 

,  CRM 

21 

2  OZ 

,ED  ,EK 

,EPS 

,  ES 

,  HLR 

,  KS 

,  KS  V 

,  MWYA 

,  CRM 

22 

3  N 

,NNN  ,P 

,PW 

,  R 

,  RA 

,RL 

,  RM 

,RZT 

,  CRM 

23 

4  S 

.SAVE  .SHAPE 

.SMALLT.T 

,TE 

,U 

,  v 

,WT 

,  CRM 

24 

5  X 

,XE  ,Z 

,ZPFR 

,ZLMT 

.SPARE 

CRM 

25 

COMMON 

/CONTRL/  DETID(12),IC(2Q) , 

IRAD, 1RISE , IS  IN 

»I  SOUT 

, JPARN.KDI 

CRM 

26 

COMMON 

/PARTCL/  NOSTR.RHCP, 

□MEAN, 

SO, PS (200) ,01 AM(2Q1) , 

FMASS (200) 

CRM 

27 

COMMON 

/TABLES/  MCX, 

CX(50, 

10),  GDPST(10, 

100) 

CRM 

28 

CRM 

29 

DIMENSION  Y ( 23 0 ) 

CRM 

30 

EQUIVALENCE  < Y ( i ) , GCPST ( 1)  ) 

CRM 

31 

CRM 

32 

CRM  34 

COMPUTE  THE  PARTIAL  PRESSURE  OF  THE  WATER  VAPOR  IN  THE  CLOUD  CRM  35 
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CRM 

36 

35 

py=P*X*29./<18.«-2  9.*X) 

CRM 

37 

CRM 

38 

COMPUTE  SATURATION  HATER  VAPOR  PRESSURE  AND 

CLOUD  AIR  MASS 

CRM 

39 

CRM 

40 

ES=61i.  ♦(T/273  .) *♦ < -  5.13) »E XP ( ( 2 5. * < T-c 73 . ) > /T ) 

CRM 

41 

PA-  RM/V*(i.+X)/(1.*X+SHWT> 

CRM 

42 

CRM 

43 

WET  OR  ORV  EQUATIONS 

CRM 

44 

CRM 

45 

GO  TO  <  150  ,1531,1531) ,N 

CRM 

46 

150 

IF(ES-PW)152, 152, 1531 

CRM 

47 

CRM 

48 

STORE  VARIABLES* KSV=1)  OR  RESTART  AT  PREVIOUS  TIME  STEP  (KSV=2) 

GRM 

49 

CRM 

50 

15  2 

KSV  =  2 

CPM 

51 

1532 

CALL  RSTR 

CRM 

52 

9 

VTEMPY=V 

CRM 

53 

CRM 

54 

INTEGRATE 

CRM 

55 

CRM 

56 

CALL  RKGILL 

CRM 

57 

CRM 

58 

ADJUST  IN-CLOUO  FARTICLE  CONCENT  RATIONS 

TO  BE  CONSISTENT  WITH 

CRM 

59 

CLOUD  VOLUME  CHANGE 

CRM 

60 

CRM 

61 

00  86  J=1,N0STR 

CRM 

62 

86 

Y*J)=Y*  J)*VTEMPY/V 

CRM 

63 

CRM 

64 

ACCUMULATE  CLOUO  TIME 

CRM 

65 

CRM 

6  6 

SMALLT=SMALLT*0ST 

CRM 

67 

CRM 

68 

TEST  FOR  TIME  STEP  CHANGE 

CRM 

69 

IF (A9S(SMALLT-1«  0) «LT.0.u01)GO  TO  87 

OR" 

7 11 

IFCSMALLT-l.C) 8,87, 88 

CRM 

71 

8  7 

DST=0ST 1 

CRM 

72 

88 

R=SQRT ( 3.* V/(RZT*12. 566370oE0) ) 

CRM 

7  3 

GC  T  .  '  - 

'*  ‘  ' 

?u 

CR. 

■  - 

CJ.-lPU’:  PARTICLE  FAilCUT  -.A  T  J 

CRM 

~  f. 

C  R  H 

77 

1531 

CALL  CPFR 

CRM 

7b 

GO  TO  *5  J1  ,9  01,8  ),MWY. 

CRM 

79 

901 

IF(IC(6)  .NE.  0)  CAL  l  DBG 

CRM 

80 

CALL  0CSN 

CRM 

81 

8 

CALL  CXPN 

CRM 

82 

GO  TO  (724,724,148) ,MWYA 

CRM 

03 

724 

KSV  =  1 

CRM 

84 

GO  TO  1532 

CRM 

85 

148 

call  crmw 

CRM 

86 

PETURN 

CRM 

87 

END 

CRM 
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♦OECK.CRMINT  CRMIN 

SUBROUTINE  CRMINT  CRMIN 

CRMIN 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  CECEMBER  197e  CRMIN 

CRMIN 

4  4444444444  44  4*4444*4  44  44  44  44  44  *444444*444444444  44  44  44  4444  44  *444  44  4444£j^MIN 

CRMIN 

INITIALIZE  CLOUO  ANC  PARTICLE  VARIABLES  FOR  THE  CYNAMIC  CLOUD  RISECRMIN 

CRMIN 

4 4* 44444444 4* 4* 44 44*44444 4444 44 4* 44 44**44444444444  44*4444 **44444 Q4 444*CR MI N 
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NORMENT ,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  CECEMBER 


COMMON 

/ATMOS/ 

NAT,  ALT (2561 

,  ATP (256) , 

PRS(  2  5  6)  ,  P.LHC256), 

CRMIN 

12 

1 

RHO (256)  ,  ETAI256), 

NHODO,  ZV(ldO) 

,  VX(100), 

V Y (130) 

CRMIN 

13 

COMMON 

/BASIC/ 

M,FW,ZBRSTZ, HEIGHT, ZSCL.SLOTMP, TMSO.XGZ 

.YGZ.TGZ 

CRMIN 

14 

COMMON 

/CLOUD/ 

CHANGE, CHLR 

*  C  2  i  C3 

,06  ,  DEK 

,DRM 

, CRMIN 

15 

1  OS 

,  OST  , 

OSTO  ,0ST1 

,OST2  ,CT 

,OU  , OWT 

,  D  X 

.CRMIN 

16 

2  OZ 

,  ED  , 

EK  ,  IPS 

,ES  , HLR 

, KS  , KS V 

,MWYA 

, CRMIN 

17 

3  N 

,  NNN  , 

P  ,PW 

,  R  ,RA 

,RL  , RM 

» RZT 

,  CRMIN 

18 

4  S 

.SAVE  , 

SHAPE  , SMALLT 

,T  ,  TE 

,U  ,  V 

»WT 

, CRMIN 

19 

5  X 

,XE  , 

Z  ,ZBFR 

,ZLMT  .SPARE 

CRMIN 

20 

COMMON 

/INITL/ 

F ,  PHI,  SSAM, 

TME,  TMPG ,  TMPS,  VFR 

CRMIN 

21 

COMMON 

/PARTCL/ 

NOSTR,RHCP,DMEAN,SD,PS<20Q) ,OI AM (2C1)  , 

FMASS  (200 

CRMIN 

22 

COMMON  /TABLES/  MCX,  CX(50,10>,  G3PST (13*100)  CRMIN  23 

CRMIN  24 

DIMENSION  Y(200),CG( 200 )  CRMIN  25 

EQUIVALENCE  ( Y  C 1 )  ,  GOPST (  1M  ,  ICG  <1)  »  GOPST  (201)  )  CRMIN  26 

CRMIN  27 

44444  44444444  5144*4444444  4*444444444  4444444  4  4444444  4  **4444444444444  44  **Cl<MIN  26 

CRMIN  29 

CHANGE= 130 •  CRMIN  30 

CMLR=0.  CRMIN  31 

SMAL  LT=  0  «  CRMIN  32 

WT=0.  CRMIN  33 


DIMENSION  Y(200),CG(200) 

EQUIVALENCE  (  Y  C 1 ),  GOPST  ( 1H  ,  ICG  (!)  »  GOPST  (201)  ) 


N=1 

MHY  A=1 
KS  =  0 

DST  0  =  .03125 
DST1  =  0.25 
OST  2  =  2.5 
OST=OSTO 
SSAM=SSAM*VPR 
COMPUTE  TURBULENCE 


PARAMETER 


C2  =  AMAX1  (  0.  Q  0  AMINK  0.100.  0.1  *  W**  I- C.  3  3  33  333  333 )  ) 
SET  TURBULENT  ENERGY  DISSIPATION  PARAMETER 

C3=0.175 
C6= 1. 0 

T=TMPG 

COMPUTE  CLOUO  CENTER  HEIGHT,  VOLUME,  RADII,  INITIAL  MIXING 


Z=HEIGHT«-ZBRSTZ4  9  G.*W**  3, 3  33  33  3  3333 
CALL  TRPLIZ.NAT  , AL  T , ATP, TE ) 

CALL  TRPLIZ.NAT  ,ALT,PRS,P) 

CALL  TRPLI Z,NAT  .ALT  ,RLH,HLR) 

XE= 139  «  93*HLR* (TE/ 2 73.  ) ** ( - 5 . 13  > *EXP ( <  2 5. *  (T E- 


27  3.  )>/TE) /CP*29.) 


T  AO  =  0  • 


CRMIN  31 
CRMIN  32 
CRMIN  33 
CRMIN  34 
CRMIN  35 
CRMIN  36 
CRMIN  37 
CRMIN  38 
CRMIN  39 
CRMIN  <*0 
CRMIN  41 
CRMIN  42 
CRMIN  43 
)  CRMIN  44 

CRMIN  45 
CRMIN  46 
CRMIN  47 
CRMIN  48 
CRMIN  49 
CRMIN  50 
CRMIN  51 
RATIOS  uRMIN  52 
CRMIN  53 
CRMIN  54 
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CRMIN  56 
CRMIN  57 
♦29.)  CRMIN  56 
CRMIN  59 
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IF(TMPS-848.)5,5,6 

5  TPR=TMPS 
GO  TO  7 

6  TPR=  848 . 

T  AD- 10 j 3.8*(TMPS-TPR) +  0. 0 6755*{ TMPS** 2-TPR** 2) . 

7  SOILHT-SSAM*  tTAD+781 .6*  (TPR-TE)  ♦0.2  856*  <TPR»  *2-T  E**2 >  ♦ 
li«3  8lE*7*<l./TPR-i./TE)> 

TAO=0. 

TPR=T 

IFCTPR-230C. 117,17,16 

16  T A0=  -i 587 .5*  <T PR-2 3  0  0. )  +  1.  0625*< TPR** 2-<  2 300 . )**2) 

TPR  =  23i.  0  * 

17  FQ=4.18E12*F*W-S0I!LHT 

RHA0=PH1*FQ/ (TA0  +  94  6.6MTPR-TE) ♦ 0. A  98 55* (TPR**2-TE** 2) ♦ XE* ( 1 697. 
i  *(T-T£)  ♦  0.572C87*(  T*T2-TE**2>  >  > 

RNW0*FQ*<1  .-PHI)  /<lo97.66*(T-TE)  +0. 572087*(T**2-TE**2>  +  2.5E6) 

1  ♦RMAQ*XE 
X=RMW0/RMA0 
RM=RMAO^RHHO+SSAM 
S=SS  AM7RMAO 

Vx(RHA0+RHW0)*287.*T* (1.* 29. 18 .) / (P* < l.*X>> 

R=0  , 

SET  SHAPE  SO  THAT  THE  CLOU!)  IS  AN  OBLATE  ELLIPSOID  WITH 
ECCENTRICITY^.:* 5  COMPUTE  HORIZONTAL  AND  VERTICAL  CLOUD  RADI 

SHAPE  =  G. 66144 

IFW.GT.0.0)  R=(  3.  *V  /  (12.  566370  6*  SHAPE  >>*»  <1.  fl/3.0  > 

RZT  =  SHAPE  *R 

COMPUTc!  INITIAL  RISE  VELOCITY 
U=i  •  2*  SQRT  <9.8»R) 

COMPUTE  IN  IT IAL  TURBULENT  KINETIC  ENERGY  DENSITY 
EK=  u .5*U**2 

COMPUTE  INITIAL  TURBULENT  ENERGY  LOSS  RATE 

EPS  =  C3:  (2.*EK)**i.5/RZT 
COMPUTE  ENTRAINMENT  PARAMETER 

RL  =  A MAXI (  AMAX1(  C.1Z,  0.1  *  W**0.1  ),  0. 0 i*W* *0. 33333*33 33  > 

COMPUTE  INITIAL  IN-CLOUO  PARTICLE  CONCENTRATIONS 

Q*S/ (1. 0 ♦X+S) *RM/ <V*RHOP*0,  52  359  88> 

DO  801  J=1 iNDSTR 
Y(J)-FMASS<J)*Q/PS(  J) **3 
801  CG( J ) =u • 

UPPER  LIMIT  FOR  Z  TO  PREVENT  PROGRAM  RUNAWAY 

ZLMT  =  iii0G0.0*W»*C.25  ♦  HEIGHT  +  Z9RSTZ 

RETURN 

END 


CRMIN  61 
CR  MIN  62 
CRMIN  6  3 
CRMIN  64 
CRMIN  65 
CRMIN  66 
CRMIN  67 
CRMIN  6  8 
CRMIN  69 
CRMIN  70 
CRMIN  71 
CRMIN  7  2 
CRMIN  7  3 
66CRMIN  74 
CRMIN  75 
CRNIN  76 
CRMIN  77 
CRMIN  78 
CRMIN  79 

crmin  eo 

CRMIN  81 
CRMIN  62 
CRMIN  83 
I  CRMIN  84 
CRMIN  85 
CRMIN  6  6 
CRMIN  87 
CRMIN  8  8 
CRMIN  89 
CRMIN  9  0 
CRMIN  91 
CRMIN  9  2 
CRMIN  93 
CRMIN  94 
CRMIN  95 
CRMIN  56 
CRMIN  97 
CRMIN  98 
CRMIN  5  9 
CR  MI  NIG  G 
CRM1N1C i 
CRMIN’..  0  2 
CR  MI  H1  C  3 
CR  MINI C  4 
CR  MINI  0  5 
CRMIN10  6 
CR  MINI 0  7 
CR  MI  NIC  8 
CR MI NIC  9 
CR  MI  N 1 1  0 
CR MI Ml  11 
CRMIN;  12 


non  o  ooooooooo 


*0ECK,CRMW  CRMW 

SUBROUTINE  CRHW  CRMW 

CRMW 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  CRMW 

CRMW 

*****♦*¥*¥****♦#*¥*♦**■*¥  #*♦•#*  *  *  *******  **  4  4*  *444*  4V44*44*4444444444<MlCf>ft^ 

CRMW 

CRMW  PRINTS  SUMMARY  OF  OUTPUT  OF  THE  CtOUO  RISE  MODULE .  CRMW 

CRMW 

444444*44444*44  44  44*4444444*44*4*4  444*44*444444444  44  *4  44444*  4  4*44*444, 


CRMW 

COMMON  /CONTRL/  GET  10 (12) , IC ( 20 » , IRAQ,  IRISE ♦ IS  I N »I SOUT * JPARN  ,KD I  CRMW 
COMMON  /TABLES/  MCX,  CX<50,1Q),  GDPS T ( 1 0  ,10 0)  CRMW 

CRMW 

6  FORMAT  <1  HI ///6X,42HCL0U0  RISE  AND  GROWTH  HISTORY  FOR  RUN  ***  UA  6)  CRMW 

20  FORMAT (/  CRMW 

1  49X19HCL0U9  HISTORY  TABLE//  CRMW 

1  5X5 (3  X5HCL0U0,  3X > ,  3X4H8ASE,  8X3HTQP  *  7X6HRA0 IAL,  CRMW 

2  3X11HTEMPERATURE.4X,  3MGAS/  CRMW 

3  8  X4HTIME ,  5X8HINTERVAL ,  5X4HBASE,  6X3HTOP,  6X6HRA0IUS,  CRMW 

4  3X3(3  X4HR AT E ,  4X)  ,  14X,  7H0ENSITY/  CRMW 

5  5X2 (3X5H(S~C),  3X  )  ,  3(4X3H(M),  4X) ,  3 (2X7H(M/$FC) ,  2X),4X,  CRMW 

6  3H(K),5Xi:H  <KG/M**2>//  (1X12,  1H)  ,  IX,  11511. 4J)  CRMW 

CRMW 

CRMW 

WRITE (ISOUT ,61  OETIO  CRMW 

WRITE(ISOUT,20)  (J,(CX(J,I)  ,  1=  1,  10)  ,  J  =  1 ,  MCX)  CRMW 

RETURN  CRMW 

ENO  CRMW 


1 

2 

3 

4 

5 

6 
7 
6 
9 

10 

11 

12 

13 

14 

15 

16 
17 
16 

19 

20 
21 
22 
2  3 

24 

25 

26 

27 

28 

29 

30 


79 


o  o  o  o  o  o  o  o  <n  o  oonooooo 


.jmimmwjj?,  >>>  nx-pgaa 


gSaSEBCAfl. 


♦DECK.  CXPN 

SUBROUTINE  CXPN 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976 


CXPN 
CXPN 
CXPN 
CXPN 
CXPN 

CXPN  TABULATES  THE  CLOUD  RISE  ANC  EXPANSION  CUTFUT  TABLE  ARRAY  CX  CXPN 
AND  TESTS  FOR  R-RATE,  U,  EK.  AND  MCX  SHUT-OFF  CXPN 

CXPN 
►uXPN 
CXPN 


DATA  WORD1,  W0R02,  WCRD3  / 6HR  RATE,  6H  MCX  ,  6H  U,EK  / 

5000  FORMAT(/////10X.  46HCL0U0  RISE  IS  TERMINATED  IN  CXPN  AT  STATEMENT 
14,  8H  BY  THE  A6,  7H  SHITCH///) 


♦  »4 


i  4  *  ¥  #  *•  *  *  l 


PERFORM  FIRST  PASS  INITIALIZATION 

GO  TO  ( 0 C 2 1  02C,  040,  MHYA 
002  DO  034  MJ  =  1,  10 
DO  034  MI  =  5  C 

C  0  4  CX  (MI,  MJ)  =  c • U 
MCX  =  1 
KWYA  =  2 
OLTM  =  0.0 
TSTM  SMALL! 

TSRE  =  AMAXU1C.,  A  MINI  (  23.  ♦  9 .  ♦  ALOG10(  W  ),  60.  )) 
TSRQ=rXP(0.014776*ALCG (W) -7. 0499) 


CXPN 

CXPN 

CXPN 

ICXPN 

CXPN 

CXPN 

►CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 

CXPN 


1 

2 

3 

4 

5 

6 
7 
6 
9 

10 


COMMON 

/BASIC/ 

W »  FW »  ZBRSTZ 

.HEIGHT 

, ZSCL , SLD  TMP , 

TMSO,XGZ,YGZ,TGZ 

CXPN 

11 

C  MMON 

/CLOUD/ 

CHANGE 

,cmlr 

,C2 

,C3 

,  C6 

, DEK  , ORH 

,  CXPN 

12 

1  OS 

,osr  , 

OSfO 

,OSTi 

,  OS  T  2 

,  OT 

•  DU 

,  DW  T  ,  0  X 

,  CX  PN 

13 

2  DZ 

,  ED 

EK 

,EPS 

,ES 

,  HLR 

,  KS 

, KS V  , MN  YA 

,  CXPN 

14 

3  N 

,  NNN  , 

P 

,PW 

,  R 

,  RA 

,RL 

,RM  , RZT 

.CXPN 

15 

4  S 

, SAVE  , 

SHAPE 

,SMALlT,T 

»  TE 

,u 

,  X  vWT 

,  CX  PN 

16 

5  X 

,  XE 

7 

,ZBFR 

,  ZLM  r 

, SPARE 

CXPN 

17 

COMMON 

/CONTRL/ 

DET ID (1 2 ) , 

IC (20  )  , 

IRAu, iRISE, IS 

IN.ISOUT, JPARN,KOI 

CXPN 

18 

COMMON 

/INI TL/ 

F,  PHI 

,  SSAM ,  TME, 

TMPG,  TMPS , 

VP  R 

CXPN 

19 

oOMMON 

/TABLES/ 

MCX, 

CX  (50 

,13),  GOPSTUO, 

ICO) 

CXPN 

20 

21 

22 

2  3 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 


ZBFR  a  Z 

CXPN 

41 

GO 

TO  040 

CXPN 

42 

CXPN 

43 

IS 

IT  TIME  TO  RECORC  CLOUD 

STATUS 

IN  THE 

CX 

ARRAY 

CXPN 

44 

VES  -  TO  iuc 

CXPN 

45 

n.-  -  To  ■; 7 c 

j 

-  b 

uXpN 

*  7 

Z  F 

(  ‘A  l  _  T  -  TlT*  )  .  F?,  .1- 

»  •  <- 

C  f  '  0 

.  f 

C* 

OX 

<  1C  X  ,  1  )  -  J  ••  AL  L  1 

O  X  '  1 4 

.  -J 

•  c 

(7  -  2  3  F  •-  )  .41,  .  ^c,  .‘♦v. 

L  X  t-  In’ 

r 

(.41 

1 1 

=  Z  '  F  R 

L  ON 

51 

GO 

3  34J 

CX  F  N 

52 

0  42 

ZA 

=  7 

CXrN 

53 

2  43 

CX 

<^C'a,  5)  -  ? 

CXPN 

54 

0  X 

(MCX,  9)  -  T 

CXPN 

55 

CXCMCX, 1C) =RA 

CXPN 

5b 

TEST 

TO 

•  NO  CRH  COMPIJT  AT  ION 

w  X  PN 

3  7 

Tr*  . 

:  MCX  .LE.  5  )  GO  TO  S', 3 

CXPN 

56 

o  o  o 


C 


C 


C 

c 


c 


IF (  TSRD  .LT.  TSTR  .OR.  U  .GT.  0.0  )  GC  TO  343 

CXPN 

61 

243 

MWY  A  =  3 

UXPN 

62 

NSTAT  =243 

CXPN 

63 

WRITE(ISOUT,5QQO)NSTAT,WORQ1 

CXPN 

64 

GO  TO  543 

CXPN 

65 

343 

IF (  T SR£  .LT.  EK  .CR.  U  .GT.  0.0  >  GO  TO  543 

UXPN 

66 

443 

MWYA  =  3 

CXPN 

67 

NSTAT=443 

UXPN 

60 

WRITE(ISOUT*5000) NS  TAT, WORD  3 

CXPN 

69 

543 

CX  ( MCX ,  3)  =  ZA  -  RZT 

CXPN 

7  U 

CX  (MCX,  4)  =  ZA  ♦  RZT 

CXPN 

71 

060 

MCX  =  MCX  ♦  1 

CXPN 

72 

CHECK  CAPACITY  i 

OF  ARRAY  CX 

CXPN 

73 

IF  (MCX  -  50)  062,  062,  061 

CXPN 

74 

061 

MWYA  =  3 

CXPN 

75 

NST  AT  =  6 1 

CXPN 

76 

WRITE (ISOUT, 500  0) NS  TAT, W0R02 

CXPN 

77 

C62 

CXM  =  MCX 

UXPN 

78 

CXPN 

79 

COMPUTE  THE  TIME  AT  WHICH  THE  NEXT  CX  ARRAY  ENTRIES 

ARE  TO  BE  MAOECXPN 

ec 

CXPN 

ei 

DLTH  =  OLTM  ♦  CXM  *  .08^946 

UXPN 

82 

TSTM  =  TSTM  ♦  OLTM 

CXPN 

83 

065 

IF  (Z  -  Z8FR)  068,  U68,  087 

CXPN 

84 

067 

ZBFR  =  Z 

CXPN 

85 

068 

GO  TO  (070,  070,  100),  MWYA 

UXPN 

6  6 

070 

RETURN 

CXPN 

87 

COMPLETE  OUTPUT 

CX  TABLE 

CXPN 

88 

100 

MCX  =  MCX  -  1 

CXPN 

89 

IF  (CX  (MCX  -  1,  1)  -  CX  (MCX,  1))  102,  lOu,  102 

CXPN 

9  0 

1C2 

DO  104  MK  =  2,  MCX 

CXPN 

91 

COMPUTE  TIME 

INTERVAL  LENGTH 

CXPN 

92 

CX  (MK  -  1,  2)  =  CX  (MK,  1)  -  CX  (MK  -  1,  1) 

CXPN 

93 

COMPUTE  VERTICAL  RATES 

CXPN 

94 

CX  (MK  -  1,  6)  =  (CX  (MK-  3)  -  CX  (MK  -  1,  3))  / 

CX 

(MK  -  1,  2) 

CXPN 

95 

CX  (MK- 1 ,  7)  =  (CX  (FK,  4)  -  CX(MK-1,  4>>  /  CX  <  MK- 

1,  2) 

UXPN 

96 

COMPUTE  RACIAL 

RATE 

CXPN 

97 

104 

CX  (MK  -1,6)=  (CX  (MK,  5)  -  CX  (MK  -  1,  5))  / 

CX 

(MK  -  1,  2) 

CXPN 

no  116  ML  =  1,  MCX 

CXPN 

99 

10  6 

CX  C-L,  1)  =  CX  (f'L,  1)  +  THE 

CXPN 

1.0 

GO  TO  .17- 

^  X.  -  N 

1  1 

ooo  O  O  OoOOOOOOO 


DBG  1 

DBG  2 

DBG  3 

DBG  4 

DBG  5 

**#»«**********#»»*«+*****»»******#***«»*»**'»**<-4*  «  +  ****«  *#***4***'*»*»Q3G  g 

DBG  7 

DBG  8 

DBG  9 


♦OECK.DBG 

SUBROUTINE  DBG 

H.  G.  NORMENT,  ATMGSFHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978 


CRH  DEBUG  PRINTOUT 


****************** ♦  ♦¥*  *** *************** ♦♦♦##*#♦«#¥*♦*+*♦♦♦»♦♦♦¥*♦♦♦♦ 

♦DBG 

10 

DBG 

11 

COMMON  /CLOUD/  CHANGE, CMLR  ,C2  ,C3  ,Cfc 

,  DE  K 

,  O  RM 

,  DBG 

12 

1  DS  ,DST  , OSTQ  ,GST1  ,0ST2  , DT  , DU 

,  DWT 

,  DX 

,  DBG 

13 

2  DZ  , ED  , EK  ,EPS  ,ES  ,  HLR  ,KS 

,  KS  V 

,  MWYA 

.DBG 

14 

3  N  ,  NNN  ,P  ,PW  ,R  ,  KA  ,  RL 

,  RM 

,  RZ  T 

,  DBG 

15 

4  S  .SAVE  .SHAPE  .SMALL T . T  , TE  ,U 

,v 

,  WT 

,  UBG 

16 

5  X  ,XE  ,Z  ,ZB FR  , ZLMT  .SPARE 

DBG 

17 

COMMON  /CONTRL/  CETIG (12 1 , I C ( 2G ) ,IKA D, IRISE , IS 

IN 

.ISOUT 

,JPARN,KDI 

09G 

18 

COMMON  /PARTCL/  NO STfi.RHOP , DMEA N, SO,  PS ( 2 CO >  , DI 

AM 

(201)  , 

FMASS  (20i ) 

DBG 

19 

COMMON  /TABLES/  MCX,  CXI50.10),  GDPS  T ( 1 1 , 1C  0 ) 

DBG 

20 

DBG 

21 

OIMENSION  Y  (2C3  )  ,CG  (  20(5 ) 

DBG 

22 

EQUIVALENCE  ( Y < 1 > , GCPST(l) ) ,  (CG ( 1) , GDP  ST < 2 0 l) 

) 

DBG 

23 

DBG 

24 

016  FORMAT  (1HQ  / 

DBG 

25 

1  3X1P9E13.4  / 

DBG 

26 

2  (10X1H*.  5X8E13 • 4  ) ) 

DBG 

27 

17  FORMA T( 21X,»PS*,11X,*CG*,11X,*Y*. 11X ,*PS«,11X, 

*C 

G¥  *  1 1 X 

Y+/16X,1P6U6G 

28 

1E13.4) 

DBG 

29 

099  FORMAT  (1H0  /  49X17FCL0U  C  0E8UG  PRINT  // 

DBG 

30 

1  9X2HST,  11X1HU,  12X1HX,  12X1HT,  12X1HR,  12X1HZ 

,  12X2HEK, 

DBG 

31 

2  11X1HV,  12X2HWT  /  10X1H*.  11X2HTE,  11X2HRM, 

11X2HES, 

DBG 

32 

3  11X1HP,  12X2HPW,  11X2HED.  10  X3HRLH ,  11X1HS/ 

DBG 

33 

4  10X1H*.  1 0X3HEPS,  1QX3HRZT  ,  9X4HCML  R  » /// ) 

DBG 

34 

03G 

35 

4*4**44  ****  *  4*4  ******  *4  4*  4*  *44  4  *****  *  *4  *  **■*♦***♦****¥♦  ********4*  ******Qt3G 

36 

DBG 

37 

IF  (AMOO  <  SMALLT ,  13.0))  2146,  1149,  2146 

OSG 

38 

1149  WRITE (ISOUT, 99) 

DBG 

39 

2146  IF  {SMALLT )  1146,  1146,  3146 

DBG 

40 

3146  IF  CSMALLT-AINT<  SMALL  1) )  1  49  ,  hU6 , 149 

DBG 

41 

4146  IF (AMOO (SMALLT, 2.0) >1146,149,1146 

DBG 

42 

1146  WRITE (ISOUT, 16) 

DBG 

43 

1  SMALLT,  U,  X,  T,  P,  Z,  EK,  V,  WT, 

UBG 

44 

2  TE,  RM,  ES,  P,  FW,  EC,  HLR,  S, 

DBG 

45 

3  EPS,  RZT  ,  C HLR 

DBG 

46 

WRITE (ISOUT ,17) 

DBG 

4  7 

1  (PS  (I) ,  CG  (I) ,  Y  (I), 

DBG 

48 

2  PS  (I  *  1),  CG  <1  ♦  1),  Y  (I  ♦  1)  , 

DBG 

49 

3  1  =  1 «  NO  STR, 2) 

DBG 

5lj 

149  RFTURN 

DBG 

51 

rN  J 

O  3  G 

52 

-# 

:rc«,  onj.-j 

DC  jN 

1 

SUJROUTI,4"  OCSN 

DCSN 

c 

OCSN 

3 

c 

H.  G.  NQRMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  - 

DEGEM8ER  1976 

DCjN 

4 

c 

OCSN 

5 

c 

4*44444444444444*44**  44-  44*44444  4  4 4* 444444444**44*4  4  *  *4  * 44 *4** 4  44*4**  44  QQ  5^ 

6 

c 

OCSN 

7 

c 

DC SN  DETERMINES  AT  THE  ENO  OF  EACH  TIME  STEP  WHETHER  TO 

DCSN 

6 

c 

CONTINUE  THE  CRM  COMPUTATION 

OCSN 

9 

c 

DCSN 

10 

c 

+**4*4444444*4**444**4*4* 4* 4*44*44**444*44*4**4**4 ♦♦*♦♦♦*♦♦**«#♦#»♦*+» QQ5N 

11 

c 

OCSN 

12 

COMMON  /CLOUO/  CHANGE, CMLR  ,C2  ,C3  ,C6 

,  DEK 

,  ORM 

,  OCSN 

13 

i  OS  , OST  ,  0  STG  »DST i  ,OST2  , DT  , DU 

,  DWT 

,OX 

,  OGSN 

14 

2  DZ  ,EO  , EK  .EPS  ,ES  , HER  , KS 

,KSV 

,  MWYA 

,  DCSN 

15 

3  N  , NNN  ,P  ,PW  . R  ,RA  , RL 

,  RM 

,  RZT 

,  DCSN 

16 

4  S  .SAVE  .SHAPE  .SMALL T. T  , TE  ,U 

,v 

,  WT 

,  OCSN 

17 

5  X  . XE  ,Z  . ZBFR  , ZLNT  .SPARE 

DCSN 

18 

COMMON  /CONTRL/  OETIO ( 12 ) , I C < 2 0 ) , IRAQ , IRI SE , IS  IN ,1 SOUT , 

JPARN  .KOI 

OCSN 

19 

c 

OCSN 

20 

066  FORMAT (14H0 SWITCH  TC  ORY) 

DCSN 

21 

077  FORMAT (14H0SWITCH  TO  WET) 

OCSN 

22 

038  FORMATUHi,  9X,  46 HCLOUD  RISE  IS  TERMINATED  IN 

OCSN  AT 

STATEMENT 

IDCSN 

23 

14,  8H  BY  THE  A6,  7H  SWITCH///) 

DCSN 

24 

c 

OCSN 

25 

DATA  WO  ROl  ,i  W0RC3,  W  (R04  /6M  TEMP  , 

6H  ZLMT 

, oHR.LT, 

1/DCSN 

26 

c 

DCSN 

27 

c 

4  444  4  444444  44 #444 4 4*44# 4 ***♦* 4* 4444 4* 444 44 444 444 44 ***** ******** *44** 44 Q Q $ 

28 

c 

DCSN 

29 

GO  TO  (151,154,1531) ,N 

DCSN 

30 

c 

DCSN 

31 

c 

SHOULD  WE  SWITCH  TC  WET  MOOE - 

OCSN 

32 

c 

YES--  TO  041 

OCSN 

33 

c 

DCSN 

34 

1531  IFCES-PW)  041,  041,008 

DCSN 

35 

c 

DCSN 

36 

041  N=2 

DCSN 

37 

IF(IC(5))151, 151, 1041 

DCSN 

38 

1041  WRITE ( I SOUT , 77) 

DCSN 

39 

GO  TO  151 

DCSN 

40 

c 

DCSN 

41 

c 

154  SHOULD  WE  SWITCH  TO  CRY  MOOE- 

DCSN 

42 

c 

NO  TO  151 

DCSN 

43 

c 

OCSN 

44 

154  IF  (  WT  1.  OE-fi)  153,153,1  51 

DCSN 

45 

153  N=1 

DCSN 

46 

WT=  0  • 

DCSN 

47 

DWT  =  0  . 

DCSN 

48 

IF(IC(5))151,151,152 

OCSN 

49 

152  WRITE (ISOUT, 66) 

OCSN 

50 

c 

DCSN 

51 

c 

TEST  FOR  TIME  STEP  CHANGE 

DCSN 

52 

c 

DCSN 

53 

151  IF  (SMALLT  -  CHANGE)  014,  015,  015 

DCSN 

54 

015  0ST=0ST2 

DCSN 

55 

c 

DCSN 

56 

c 

TEST  FOR  ANOMALOUS  CLOUO  RISE  ANO  SET  UP  TERMINATION  CONDITION  IF  OCSN 

57 

c 

anomaly  IS  F^UND 

OCSN 

58 

c 

OCSN 

6 1 

c 

DCsN 

£2 

Oi* 

IF  (ABS(T)-IO.) 114»  £0,20 

DCSN 

63 

114 

NST  AT  =  1  4 

OGSN 

64 

W0R0=W0RD1 

DCSN 

65 

GO  TO  1 

OCSN 

66 

c 

DCSN 

67 

c 

TEST  FOR  R.LT.l  ANOMALY 

OCSN 

68 

c 

OCSN 

69 

020 

IF ( R-l • )  120 ,13*13 

OCSN 

70 

120 

NSTAT=20 

DCSN 

71 

W0RD=H0P04 

DCSN 

72 

GO  TO  1 

DCSN 

73 

c 

OCSN 

74 

c 

TEST  FOR  ZLMT  ANOMALY 

DCSN 

75 

c 

DCSN 

76 

013 

IF  (Z  -  ZLMT)  008,  008  ,  113 

OCSN 

77 

113 

NST  AT=1 3 

DCSN 

78 

WORO=WORD3 

DCSN 

79 

c 

COMPLETE  CX  TABLE 

DCSN 

80 

001 

MWYA  =  3 

DC^N 

81 

WRITF ( I  SOU  T, 88 )  NSTAT.WORO 

DCSN 

82 

006 

RETURN 

DCSN 

83 

ENO 

DCSN 

84 

OOOOOO  oooooooo  o  oo  o  o  o  O  O  oo 


CALL  TRPL(  2»NAT  , ALT  ,RLH, HLR.) 


COMPUTE  AMBIENT  AIR  WATER  MIXING  RATIO 

XE=109.98*HLR* (TE/27 2. >♦*< -5 . 13 ) *  EXP (( 2 5 .* (T £- 27 3. )) /TEI / eP* 29. ) 
TAO=0. 

COMPUTE  SPECIFIC  HEAT  OF  IN-CLOUC  AIR 

IF (T-2300.  1  15,  15,16 
TPR=T 

CP=946.6+0.1971*T 
GO  TO  17 
TPR=23O0. 

TA0=-3587. 5  +  < T-TPR) +1.0625* <T*+2-TPR**2) 

CP=-3587.5+2.125*T 

CP= <CP+XM 1697. 66+  1.1441 74*T> )/ I i.+X) 

CPAI  =  TAO+946.6+(TPR-TE  HU.  098  55*  { TPR  **  2 -TE**  2) 

COMPUTE  SPECIFIC  HEAT  OF  IN-CLOUC  AI R- W ATER-SO I L  MIXTURE 

RMIX=<1.+X)/<1,+X+S+WT) 

CR=CP*RMIX 

IF(TMPS-T) 380 , 381, 361 

IF ( T-84  8 . )  3810,3810,3811 

CS=  781.  6+0. 5612*T'»1.881E7/T **2 

GO  TO  3812 

CS=1003.8+0.13510*T 

CR=CR+CS+(S+WT»/ (l.+X+S+WT) 

QXE=(1. +XE)/(1.+29.*XE/18. ) 

QX=  (l.  +  29.*X/18. )/ (i.+X) 

QT=T/TE 

COMPUTE  HORIZONTAL  RADIUS  OF  CLOUD 
R=SQRT {3.+V/(RZT*12.5663706EQ > ) 

IS  CLOUD  CENTER  ALTITUOE  GREATER  OR  LESS  THAN  ALTITUDE  OF  PREVIOI 
TIME  STEP 

GREATER-  TO  1101 
LESS  -  TO  1100 
IF (KS.GT.Q )  GO  TO  1102 
IF ( Z-ZBFR) 1100,1101,1101 

oz=o. 

U=0 . 

DU-0. 

NNN  =  2 

GO  TO  1112 
NNN  =  1 

COMPUTE  CLOUD  S  TC  VCLUMt  RATIO 
SV=12.36o37jfc*«*'2/V 

COMPUTE  TURBULENT  KINETIC  ENERGY  DISSIPATION  RATE 

£PS=C3* (2. +EKI *+i. E/RZT 
Q7  =  AMAX1  (ABSCU)  , SORT  «2.*EK  )  ) 

QQ=QT*QX*QXE*  < 1. +X+WT)/ < l.  +  X+S+WT) 


DERIV  32 
DERIV  33 
DERIV  34 
DERIV  35 
OERIV  36 
OERIV  37 
DERIV  33 
DERIV  39 
OERIV  40 
OERIV  41 
DERIV  42 
DERIV  43 
DERIV  44 
DERIV  45 
DERIV  46 
DERIV  +7 
OERIV  48 
DERIV  49 
DERIV  50 
OERrV  51 
DERIV  52 
DERIV  53 
DERIV  54 
DERIV  55 
DERIV  56 
DERIV  57 
DERIV  58 
DtRIV  59 
DERIV  60 
DERI  V  61 
OERIV  62 
DERIV  63 
DERIV  64 
DERI v  65 
OERIV  66 
DERIV  67 
OERIV  68 
DERIV  69 
.SDERIV  70 
DERIV  71 
DERIV  7 2 
DERIV  73 
DERIV  74 
DERIV  75 
OERIV  76 
DERIV  77 
DERIV  78 
DERIV  79 
DERIV  30 
OERIV  01 
DERIV  62 
DERIV  o  3 
CEP. IV  u 
OERIV  -ID 
O  E  i-  i  V  3  6 
DERIV  1 7 
OERIV  36 
DERIV  S9 
OERIV  9u 
OERIV  31 


ooo  ooo  o  o  o  ooo  O  O  O  O  oooooo  ooo 


IF(NHODO)iiQ3,li03,li04 

1103  vs=o.u 

GO  TO  1105 

COMPUTE  WINO  SHEAR  CfRRECTIGS  FACTOR 

ZTP=Z*RZT 
ZBTsZ-RZT 

CALL  TRPUZTP,  NHQOO,ZV,VX,VXT) 

CALL  TRPlIZTP,NHOOO  ,ZV,VY, VYT) 

CALL  TRPL ( ZBT , NH000*ZV,VX,VXB) 

CALL  TRPl(  ZBT , NHOOO  , ZV  »VY ,  V  YB) 
VS=SQRT ( (VXT-VXB) ** 2  +  ( VYT- VYB ) ** 2 ) 
RS=SV*Q7*1.5*C6*VS/R 
GO  TO  (  103 ,101,100  )  ,N 

DRY  EQUATIONS 


COMPUTE  AIR  ENTRAI KMENT  RATE 

100  ORM=(RM/(l.-CPAI/CCP*T»QX))  )*RMIX*{RS  *RL«-  (Q  T*  CX  *QXE*9 .8*U 

1RMIX/(CR*T*QX) -9.8*U/<287./QXE*TE> ) 

ORME  =  ORM 

SUBTRACT  AWAY  RATE  CF  MASS  LOST  CUE  TO  PARTICLES  FALLING  OUT 
BOTTOM  DURING  RISE 

ORM=DRM-CMLR 

COMPUTE  TIME  DERIVATIVE  OF  WATER  VAPOR  MIXING  RATIO 

OX=-( i. +X+SJ /(l.+Xtl*  (X-XE) *DRME/RM 

COMPUTE  TIME  DERIVATIVE  OF  CLOUD  TEMPERATURE 


DT=-(RHIX*(QT*QX'rQXE',9.8*U-EPSI  +C°AI*DRME/RM)/CR 
WT=0. 


NO  CHANGE  IN  LIQUID  WATER  MIXING  RATIO 


owr=o. 

GO  TO  555 

WET  EQUATIONS 

101  Q1=1.+X*Z9./1B. 

IF{T*273.) 102,103,103 
1C  2  CL  =  2  •  8  3  E  6 
GO  TC  !■•!* 

1-3  CL=2.5:fc 
104  n2=Cl*X/ (287. *T) 
03=18, *02/29. /T 
Q4  = 1*  *Q  2 
Q5=1,*CL*Q3/CP 
Q6=CL4(X-XE)/CP+T~TE 
09=RMIX/Q5 
Q8=Q9/T/QX 


DERI V  92 
DERI  V  93 
DERIV  i<* 
OERIV  95 
DERIV  56 
DERIV  97 
DERIV  56 
DERIV  99 
UERIV1 JO 
DERIV ill 
DERI  V 15  2 
DERIV1 33 
OERIV104 
DERI  VI C5 
DERI  VI I  6 
DERIV 1 J7 
0ERIV1J8 
OEPIV109 
DEKIV110 
DERIV111 
DERI VI 12 
-EPS )  •■OERIV  113 
DERI Vl 14 
0ERIV115 
DERlVllb 
CL0UDDERIV117 
DERI VI 18 
0C.RIV119 
DERIV120 
OERIV121 
OEPIV122 
OER1 V123 
DERI V 124 
DERIV 12 5 
OERIV 126 
CERIV127 
OERIV128 
DERIV129 
QERI V130 
OERIV131 
0ERIV132 
DERIV133 
DERI  VI 34 
DERI VI 35 
OERIV 136 
OEKi V137 
OER1V138 
DERIV139 
DERIVIhO 
D  £  ^  I  V  1 4 1 
OERIVi^ 
0E  kI VI 4  3 
DERIV!-*** 
DERI  Vi  45 
PERI  VI h6 
OERIV147 
OER IV148 
DEkI V14H 
DERI  VI 50 
DERJ.VlSi 


rkM/nATl  VCklT  D  A  T  C* 


C  DERI  VI 52 

DRM=RMIX*(RM/ (l.C-Q6*Q8 ) )*(RS*RL*  <QX*Q T*9 . 8 U*Q XE-EPS ) /CP/T/Q X*D E RI VI 53 


lQ9-(9.8*U)/(287./QXE*TE)  ) 

DERI  VI 54 

ORME=DRM 

DERIV155 

c 

DERI  VI 56 

c 

SUBTRACT  A  HAT  RATE  OF  MASS  LOST  CUE  TO  PARTICLES  FALLING  OUT 

CLOUDOERI VI 5  7 

c 

BOTTOM  DURING  RISE 

DERIV158 

c 

DERIV159 

ORM=ORM-CMLR 

DERI V160 

c 

DERIV161 

c 

COMPUTE  TIME  DERIVATIVE  OF  TEMPERATURE 

DERIV162 

c 

DERIV163 

DT=  <<-QX*Qr*Q4*9.8*U/CP*QXE-Q6*0RM£/  (RMIX*RM)  )  ♦EFS/CF)  *Q9 

DERI V164 

c 

DERIV165 

c 

COMPUTE  TIME  DERIVATIVE  CF  HATER  VAPOR  MIXING  RATIO 

DERI  VI 6  6 

c 

DERIV1G7 

DX=Q1*<  Q3*OT«-9.8»X*U/(28  7.*TE>*QXE> 

DERI  VI 68 

c 

DERIV169 

c 

COMPUTE  TIME  DERIVATIVE  OF  LIQUID  HATER  FIXING  RATIO 

DERIV170 

c 

DERI  VI 71 

OWT=-(l«+X+S*-WTI/RM*  (WT*X-XE)/(i.+XE)*URME-DX 

OERI V172 

c 

DERIV173 

555 

EOi®  2.*C2*Q7*QQ/RZT 

DERIV174 

GO  TO  (621,1110) , NNN 

DERIV175 

621 

CONTINUE 

DERI  VI 76 

c 

DERIV177 

c 

COMPUTE  CLOUD  VERTICAL  ACCELERATION 

DERIV178 

c 

DERI  VI 79 

DU  -  9.8  *  (QT*QX*GXE*RMIX-1, )  -  (  EDI  +  DRM/RK  )  *  U 

DERI VlfiO 

c 

COMPUTE  EDDY  VISCOUS  RATE  OF  LOSS  OF  KINETIC  ENERGY  OF  RISE 

DERIV181 

c 

OEKIV182 

mo 

E0=E01*U*‘*2 

0ERIV183 

c 

COMPUTE  TIHE  DERIVATIVE  CF  TURBULENT  KINETIC  £ FERGY  DENSITY 

DERI  VI 6  A 

c 

DERIV135 

OEK=ED- <EK-0.5*U**2)*GRME/RH-EPS 

OERI V 18  6 

c 

DERIV187 

c 

COMPUTE  TIHE  DERIVATIVE  OF  SOIL  MIXING  RATIO 

DERIV188 

c 

DERIV189 

QS=-(i.  +X*S+HT) *S/RF*!CMIR/  <S«-WT)  «-DRME/  (i.  +  XEI  ) 

DERIV190 

c 

DERIV191 

c 

COMPUTE  IN-CLOUD  GAS  DENSITY 

0SRIV192 

c 

DERI  V 1 53 

rlA=RM/V#RMI  X 

OERI V194 

IF  (  EPS  )  9 ' 2,  i‘u2, 9  1 

OERI V 19  5 

9u  2 

EPS= l.CE-4 

0ERIV196 

9«1 

RETURN 

OERI Vi«7 

END 


DERIV198 


noo  o  oooooooooo 
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*0ECK»  RKG ILL  RKGIl 

SUBROUTINE  RKGILL  RKGIL 

RKGIL 

G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  RKGIL 

RKGIL 

******#**4MMMMMMMf**<MMM>****»*+****  ♦■*■******♦#***♦♦♦*♦*****  RKG  I  L 

RKGIL 

INTEGRATES  THE  CLOUD  RISE  DIFFERENTIAL  EQUATIONS  VIA  THE  RKGIL 

RUNGE-KUTTA-GILL  METHOD  RKGIL 


COMMON  /ATMOS/  NAT,  ALT(25b>,  ATP(256),  PkS<256>,  RLH(256), 

L  RHO  (256)  ,  E  T  A  ( 2  5  £)  ,  NHOOO,  ZV(lilC),  VX(1QG>,  VY(IOJ) 

COMMON  /CLOUD/  CHANGE, CMLR  ,C2  ,  C3  ,C6  ,DEK  ,ORM 


,  OST 
*  ED 
,  NNN 
,  SA  VE 
,XE 


,  OSTQ 
tEK 

,P 


,DST1 

,EPS 

,PW 


C2 

,C3 

,C6 

,LEK 

,  ORM 

OST  2 

»  UT 

,  OU 

,  DWT 

,ox 

ES 

,  HLR 

,  K  S 

,  KS  V 

,  M  WYA 

R 

,KA 

,RL 

y  RM 

,RZT 

T 

» TE 

,u 

,  V 

,WT 

ZLrtT 

.SPARE 

DIMENSION  OVBLi S) ,V6L(8i ,RKG(8) 


H=0ST 
KS  =  0 
KYCL=1 

V9L ( 1 >  =  W  T 
V3L  < 2) =RM 
VBL  m=u 
V3L (  4  >  =  X 
VBL  (5>-T 
VBL <6 )  =  Z 
V BL(7)=EK 
VBl(B)=S 

20  CAlL  O^RIV 

IF ( A9S(U>  .LT,  l.E-10)  VBL(3)=0. 

0V3L  ( 1) =  QW  T 
D  V  3  L ( 2) =DRM 
PV9L  <3»  =DU 
0V9L (4) =OX 
DV3L (5) =OT 
DV‘3L  { f3 >  —  □  Z 
ovum  =OEK 
0V9L ( H) =05 

1/  C  =  l/C  + 1 

GO  TO  (1,3,5, 7), KS 

1  DO  2  J=!,8 

VBL ( J)  =  VBL »  J) ♦ C . 5*H*  t'VBL (J) 

2  RKG«JI=DVBL <  J  » 

GO  TO  1C 

3  00  4  J  = 1 , 8 

VBL  <  J>  =  VBL  < J) ♦ .29285322* H*  <OV9L< J> -RKG ( J ) > 

4  PKG(J)  =  «5857&644*0V6L(J)*rl21i233~l 2 3 4''RKG(J> 
GO  TO  1C 


RKGIL  8 
RKGIL  9 
RKGIL  10 
* RKGIL  ll 
RKGIL  12 
RKGIL  13 
RKGIL  14 
.RKGIL  15 
.RKGIL  16 
, RKGIL  17 
.RKGIL  16 
,  RKGIL  19 
RKGIL  20 
RKGIL  21 
RKGIL  22 
RKGIL  23 
*  RK G I L  24 
RKGIL  25 
RKGIL  26 
RKGIL  27 
RKGIL  26 
RKGIL  29 
RKGIL  30 
RKGIL  31 
RKGIL  22 
RKGIL  33 
RKGIL  24 
RKGIL  35 
RKGIL  36 
RKGIL  37 
RKGIL  38 
RKGIL  29 
RKGIL  *0 
RKGIL  41 
RKGIL  42 
RKGIL  43 
RKGIL  h4 
kKGIL  45 
RKGIl  46 
KKGIL  “ 7 
RKGIL  48 
KKGIL  49 
KKGIL  5 0 
RKGIL  51 
RKGIL  52 
KKGIL  53 
RKGIL  54 
RKbIL  55 
RKGIL  5b 
KKGIL  57 
RKGIL  56 
KKGIL  59 
RKGIL  60 


ooo  o  ooooooooo 


5  00  6  J=l,8  kKGIL  61 

VBL  ( J )  =  VBL  (  J )  + 1.  70  7136  8*  k*  ( 0V3L  ( J> -RKG  ( J ) )  RKGIL  62 

6  RKG(  J)=3.41421356*0VBL<  J ) -4 . 1 21 320 3* RKG <  J)  RKGIL  63 

GO  TO  1C  RKGIL  64 

7  00  8  J= 1 ,8  RKGIL  65 

8  VBL<J>  =  VBL<J>«-.1666e66?*HM0V8L(J»-2.*RKG<J)  )  RKGIL  66 

RKGIL  67 

KYC L=2  RKGIL  68 

10  WT= V3L ( 1)  RKGIL  69 

RM=VBL<2>  RKGIL  70 

U= VBL  (3 )  RKGIL  71 

X=V8L<4>  RKGIL  72 

T=  V9L ( 5 )  RKGIL  73 

Z=VBLC6)  RKGIL  74 

EK=  VBL ( 7 )  RKGIL  75 

S  =  VI3L<8>  RKGIL  76 

CALL  TRPL(Z*NAT  , AL T  ,PRS, PQR)  RKGIL  77 

V=287.*T*RM*(1.*X)  /PQR/  ( 1  .  +  X* S*  NT >  *  ( 1 . 0  +  X*  29./  18  . )  /  ( 1 . 0  *X>  KKGIL  78 

IF (  U  .GT.  0.0  >  RZT  =  (  0.2387324  *  V  ♦  5HAPE**2  > **Q. 3333333333  RKGIL  79 

GO  T0(20,30 ),KYCL  RKGIL  80 

30  RETURN  RKGIL  81 

END  RKGIL  82 


♦DECK, RSTR 

SUBROUTINE  RSTR 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978 


RSTR 

RSTR 

RSTR 

kSTR 

RSTR 


RSTR  PRESERVES  ANO/OR  RESTORES  CRM  VARIABLES 


RSTR 

RSTR 

RSTR 

lR3TR 

RSTR 


COMMON 

/CLOUD/ 

CHANGE 

,CMLR 

,C2 

,C3 

,C6 

,  DEK 

,ORM 

,R3TR 

12 

1 

OS 

» OST 

,  0  ST  0 

,DST1 

*  D  ST  £ 

*OT 

,DU 

,  cht 

,OX 

,  RS  TR 

13 

2 

oz 

t£0 

» EK 

,  EPS 

,ES 

,  HLF. 

,  KS 

,  KS  V 

,  MWYA 

,  kSTR 

14 

3 

N 

,  NNN 

,P 

,PW 

,  R 

,  RA 

»RL 

t  KM 

,RZT 

,  kSTR 

15 

4 

s 

» SA  V  £ 

» SHAP  t 

, SMALL  T 

» T 

,  TE 

,u 

.V 

,  W  T 

,  RSTR 

16 

5 

X 

»XE 

,z 

,  ZBFR 

,ZLMT 

, SPARE 

KS  T  R 

17 

COMMON 


l  I  jU,rCi  \  C  U  U  /  *  U, 

GDPST(1J,1J0) 


, FM AS  S  ( 20  0  >  RSTR 
KSTR 
RSTR 
KSTR 
RSTR 
KST  R 

♦  *  ***** **RS TR 
RSTR 
RSTR 
KSTR 
kSTR 
RSTR 
kSTR 


DIMENSION  P Y ( 20  0  ) ,  Y(2fl0) 

EQUIVALENCE  < Y ( 1 > , GOPST ( 1 J I ,  < P Y < 1 ) , GOPS T ( 40 1) > 


********** ********1 

GO  TO  ( 1  *  3) , KS V 
1  PEK=EK 
PRM=RM 
PSS=S 
PT  =  T 
PU  =  U 
PV  =  V 
pmt=wt 


'»♦■***¥*[ 


89 


ooooooooooooooooooooooo 


PX  =  X 

RSI  R 

34 

PZ=Z 

RSTR 

35 

PRZT=RZT 

RSTR 

36 

DO  2  NP=1, NOSTR 

RSTR 

37 

PY(NP)=Y(NP) 

RSTR 

36 

GO  TO  5 

RSTR 

39 

RSTR 

40 

SMA.U.T=SMALLT“DST 

RSTR 

41 

OST  =  OSTl 

RSI  R 

42 

EK=PEK 

RSTR 

43 

RM=PRM 

RSTR 

44 

S=PSS 

RSTR 

45 

T=PT 

RSTR 

46 

U=PU 

RSTR 

47 

V=PV 

RSTR 

48 

WT=PWT 

RSTR 

49 

X=PX 

RSTR 

50 

Z=PZ 

RSTR 

51 

RZT=PRZT 

RSTR 

52 

00  4  NP=1, NOSTR 

RSTR 

53 

Y(NP)=PY(NP) 

RSTR 

54 

N=3 

RSTR 

55 

RETURN 

RSTR 

56 

END 

RSTR 

57 

* 0£CK»  P.SXP  RSXP 

SUBROUTINE  RSXP  RS <P 

RSXP 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  KSXP 

RS  XP 

**********************  ***♦**♦*„**♦♦**.*..* *♦* 

KSXP 

AFTER  THE  DYNAMIC  CLOUD  RISE  HAS  BEEN  COMPLETE  C*  RSXP  PASSES  RSXP 

THROUGH  THE  RISE  HISTORY  TABLE,  CX,  TO  RESIMULATt  THE  RISE  FOR  T  HE  RS  XP 
PURPOSE  OF  DtFINING  A  OISTRUBUTION  IN  SPACE  /.tJOVF  GZ  OF  FALLOUT  RSXP 
PARCELS  THAT  ARE  TO  eE  TRANSPORTEO  DOWNWIND  BY  SUBSEQUENT  MODULES. RSXP 
RESULTS  ARE  WRITTEN  CN  TAPE  IRISE.  RSXP 

RSXP 
RSXP 

DPST < 1, MBT )  TIME  RSXP 

DPST  ( 2 ,  M3T )  ALTITUCE  OF  PARCEL  CENTER  OF  MASS  RSXP 

OPS  f ( 3 , M8T )  RADIUS  RSXP 

DPST ( 4, MBT )  PARTICLE  DIAMETER  MICROMETERS  RSXP 

DPST (5, M8T )  MASS  Cfi  ACTIVITY  FRACTION  RSXP 

OPST ( 6, MBT )  PARCEL  THICKNESS  RSXP 

DPST  <  /,  MBT  )  ALTITUCE  OF  PARCEL  BASE  RSXP 

OPST ( B , MBT )  PARCEL  VOLUME  RSXP 

KSXP 

RSXP 

COMMON  /ATMOS/  NAT,  ALT(256),  ATP<256>,  PRS(256  >,  RcH(256»,  RSXP 

1  RHO  (  25  6 1  ,  ETA  (256)  ,  NHOOO,  2V110U),  VXC10U),  VY(lJU  RSXP 

COMMON  /BASIC/  W  ,f  W  ,  ZBRSTZ  ,  HEIGHT  ,  2  SUL  ,  SLD  TMP,  7M  SO  ,  XGZ  ,Y  G  Z  ,  TGZ  RSXP 

COMMON  /CONTKL/  OET  ID  (i  2)  ,  IC  ( 20  )  ,  J.R*  0,  I R ISE  ,  IS  IK  ,1  SOUT  ,  J  PA  R!  ,KOI  KJ.XP 

COMMON  / INI  TL/  F,  PHI,  SSAM,  THE,  'IPG,  TMFS,  V PR  kSxP 

COMMON  /PARTCL/  NDS T R ,RH CP  ,  OMEAN ,  Si),  PS  ( 2 :  0  )  , D1  AM  (2 1)  1 )  , FMASS  <2o  0  )  RSXP 


1 

2 

3 

A 

5 

6 

7 

8 
9 

iJ 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 
3C 
31 


90 


OOO  OOO  O  OOO  O  O  O  C500000 


COMMON  /TABLES/  MCX,  CX<5Q,1G),  G0PST< 10 , 10 0 ) 

RSXP 

32 

RSXP 

33 

DIMENSION  DPST (8*2) , CPX  < 2 , 5 0 ) , VI SCX ( 5Q > ,PPST <8  ,  1 C) ,ONWAF (2)  RSXP 

34 

RSXP 

35 

444 

FORMAT  C*iV  1C  X,*DEPOSIT  I  NCREMENTS*//15X  ,*T  IME  *  ,  7X  ,*ALT* 

,  8X ,*RAD*, RSXP 

36 

17X,*DIAM*.8X,4MASS4,8X,*DZ4,7X,»ZL0W*,7X,*V0L»//) 

RSXP 

37 

666 

FORMAT ( IX* iPEil.3,7E11.3,l2,5X,I2,4IN  CLOUD*) 

RSXP 

38 

777 

FORMAT ( IX, 1PE 11. 3, 7611. 3,IZ,5X,I2) 

RSXP 

39 

888 

FORMAT (IX, 1PE11. 3, 7  Ell. 3/1X, •SUBDIVISION*, 2X, 15, 5X,*SIZE 

CL  A  SS4 , 2XRSXP 

40 

l 

,15/) 

RSXP 

41 

RSXP 

42 

43 

RSXP 

44 

INITIALIZE  WAFER  UP-CRIFT  INTERPOLATION  ARRAYS  AND  WAFER 

DATA  RSXP 

45 

ARRAYS 

RSXP 

46 

RSXP 

47 

DO  2  KA=1» 50 

RSXP 

46 

DO  2  K3=l, 2 

RSXP 

49 

2 

DPX  <KB,KA)=0.0 

RSXP 

50 

DO  3  KC=1*8 

RSXP 

51 

DO  3  KQ=1, 2 

RSXP 

52 

3 

OPS  T ( KC  * KQ) =L • 0 

RSXP 

53 

4 

KD?ST=KOI 

RSXP 

54 

DPSTK=KDPST 

RSXP 

55 

RSXP 

56 

COMPUTE  WAFER  UP-ORIFT  INTERPOLATION  ARRAYS 

RSXP 

57 

RSXP 

58 

6 

DO  7  KO=  1, MCX 

RSXP 

59 

IF(CX(K0,7)-CX(K0,  0)53,  53,54 

RSXP 

60 

53 

DPX (1,KD)=0.C 

RSXP 

61 

GO  TO  55 

RSXP 

62 

54 

DPX ( i,KG)= (CX(K0,7) -CX(KD,6) )/<CX(KD,4) -CX(KD, 3) ) 

RSXP 

63 

55 

IF  CCX  <KD,6> ) 56,56,  E7 

RSXP 

64 

56 

DPX (2,«0)a  a.Q 

RSXP 

6  5 

GO  TO  7 

RSXP 

66 

57 

DENOM=CX(KO,3) -ZBRSTZ 

RSXP 

67 

IF (0EN0M)56,56,58 

RSXP 

68 

58 

0PX<2,KD)=CX( KD,6) /OENOM 

RSXP 

69 

7 

CONTINUE 

RSXP 

70 

IF ( IC ( 6 )  «  GT .  0)  WRITE (ISOUT, 444) 

RSXP 

71 

RSXP 

72 

SET  NOMINAL  WAFER  EOGE  LENGTH  IF  WAFER  RADII  ARE  TO  BE  SUBDIVIDED  RSXP 

73 

RSXP 

74 

IF( IRAO) 78, 76,79 

RSXP 

75 

76 

87=0. 

RSXP 

76 

GO  TO  77 

RSXP 

77 

79 

82=  CX  (MCX,  5)  /F  LOAT  (  IRAO) 

RSXP 

78 

INITIALIZE  TAPE  IRISH 

RSXP 

79 

77 

REWIND  IRISE 

RSXP 

6  0 

766  2 

8Z2=3Z/2.0 

RSXP 

81 

120 

LOOO=Q 

RSXP 

82 

RSXP 

63 

COMPUTE  IN-CLOUO  AIR  VISCOSITIES 

RSXP 

6  4 

RSXP 

85 

00  6345  J= 1  ,MCX 

RSXP 

86 

6C45 

VI SCX ( J)=1,458E-6*CX(J,9)**1,5/ ( 1 10 . 4* CX ( J , 9 ) ) 

RSXP 

87 

KCX=MCX-1 

RSXP 

68 

RSXP 

69 

COMPUTE  A  SETTLING  RATE  THRESHOLD,  SRTHS.  SETTLING  RATES  LESS  RSXP 

90 

THAN  THIS  VALUE  ARE  CONSIDERED  INSIGNIFICANT  A  NO  ARE  REPLACED  RSXP 

91 

91 


o  o  r->  ooo  ooooooo  ooooooooooono  oooo 
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C  WITH  ZERO.  RSXP 

C  RSXP 

SRTHS  =  J.l  *  (  CX(  MC  X*  4  )  -  CX<  HCX,3  > ) /OPS TK/6 0 0 .  RSXP 

RSXP 

ENTER  OUTSIDE  WAFER  CALCULATION  LOOP.  THIS  LCOF  DEFINES  PARTICLE  RSXP 
SIZE  CLASSES.  RSXP 

RS  XP 

200  DO  278  MA= 1 *NDSTR  RSXP 

K0PS=2*KDPST  RSXP 

RSXP 

RSXP 

pNT ER  MIOOLE  WAFER  CALCULATION  LOOP.  THIS  LOOP  CEFINES  CLOUD  RSXP 

WAFER  SUBDIVISIONS  ■  RSXP 

RSXP 

DO  258  MS=i,KDPS  RSXP 

RS  XP 

COHPUTE  WAFER  TOF  OR  BOTTOM  INDICATOR,  MBT  RSXP 

IF  MB  IS  OOO,  MBT-2  THIS  SPECIFIES  A  WAFER  BOTTOM  RSXP 

IF  MB  IS  EVEN,  M  ET= 1  THIS  SPECIFIES  A  WAFER  TOP  RSXP 

RSXP 

M9T=2*<  <  MB  ♦  1» /2) -MB  +  1  RSXP 

RSXP 

INITIAL  DPST  VARIABLES  RSXP 

RSXP 

DPST(1,M8T) =CX(L«1)  RSXP 

OpST  <  3 , MBT ) =C X ( HCX , 5  )  RSXP 

GO  TO  ( 202, 201) ,M8T  RSXP 

2C1  0PST<4,MBT>=DIAM(MA)  RSXP 

GO  TO  2  J 3  RSXP 

202  DpST<4,MBT)=0IAM<MA*l)  RSXP 

203  DP3T(5,MBT)=FMASS(MA)/DPSTK  RSXP 

IF  {  SO  ,GT.  O.OOPST  (5, MBT)  =OPST  <5, MBT)  *SSAM  RSXP 

BM=M3/2  RSXP 

OPST (2  ,MBT)=CX Cl, 3>MCX Cl, 41-CX (1,3 >>/K0I*BM  RSXP 

ZLST=0PST«2,MBT)  RSXP 

K8AS  E= 1  RSXP 

J9A  SE= 1  RSXP 

RS  XP 

ENTER  INSIOE  WAFER  CALCULATION  LOOP.  THIS  LOOP  CEFINES  CLOUD  RSXP 

RISE  HISTORY  TIMES  IN  THE  CX  ARRAY  RSXP 

RSXP 

RSXP 

COMPUTE  OPST  TRAVEL  RSXP 

RSXP 

OO  238  MC= 1 ,KCX  RSXP 

ZVSB=0PST<  2, MBT  ) -C  X  CMC,  3)  RSXP 

IF (  A8S  <  ZVS8  )  .LT.  .1  )  ZVSB  =  0.0  RSXP 

IF(ZVSB) 204,210,210  RSXP 

20  4  GO  TO  <  206 , 20  e ) , XBASE  RSXP 

RSXP 

AO  JUST  OPST  RADIUS  AND  ALTITUOE  FOR  LEAVING  CLOLD  RSXP 

RSXP 

206  KBASE=2  RSXP 

MD=  MC-1  RSXP 

20  7  EXTM= (ZLST-CX <MO ,3)  )/ (CX (MO  ,6)-UP»0N>  RSXP 

1207  DPST ( 3, MBT) =CX (HO, 5 ) ♦EXTM*CX(WD, 8)  RSXP 

OPS T (  2,MBT)=ZLST* <UF-CN)*£XTH  RSXP 

RSXP 

IF  THE  WAFER  IS  ON  THE  GPOUND,  JIMP  THE  INNER  ICCP.  IF  NOT,  RSXP 

COMPUTE  THE  POSITKN  OF  THE  WAFER  BELOW  THE  CLOLI  BASE.  RSXP 


92 

93 

94 

95 

96 

97 

98 

99 
1J0 
101 
10  2 
1C  3 
134 
105 
1C6 
1 J  7 
1)8 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 

129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 
14.3 

144 

145 

146 
1<*7 

148 

149 

150 

151 


c 

RSXP 

152 

GO  TO  ( 1208,233} ,JBAS£ 

RSXP 

153 

120  8 

0  PST  (  2  •  MB  T)  =  DPS  T (  2  ,MB  T)  «■  ( CX  (  HQ, 6  )  -  DN )  * <CX  <MD  ,  2) -EXTMi 

RSXP 

154 

C 

RSXP 

155 

C 

COMPUTE  BELOW  CLOUO  AIR  DENSITY  ,  VISCOSITY 

AND  TEMPERATURE 

RSXP 

156 

C 

RSXP 

157 

208 

UP=CX  (MC*-6)+-ZVSB*0PX  <2 ,MC) 

RSXP 

158 

CALL  TRPLiOPST (  2, MBT), NAT  , ALT , RHG, DEN) 

RSXP 

159 

CALL  TRPL ( OPST (  2,M  ET) *  NAT  , ALT , ETA, VIS > 

RSXP 

16  0 

CALL  TRPUQPSTt  2, MBT), NAT  t ALT , ATP, TMP) 

RSXP 

lei 

GO  TO  212 

RSXP 

162 

C 

RSXP 

163 

C 

COMPUTE  INSIDE  CLOUD  GAS  OE-NSITY,  VISCOSITY 

AND  TEMPERATURE 

RSXP 

164 

c 

RSXP 

165 

210 

UP=CX  <MCr6)  ♦ZVS8*OPX(i,HC> 

RSXP 

166 

FC=  (OPST(lrMBT)-CXLMC,l>  >/(  CX  (MG +  1 , 1 > -C X ( MC 

»1>  ) 

RSXP 

167 

OEN  =  CX(MC.10>  MCX(MC  +  1,10)-CX (MC.l Q)  )*FC 

RSXP 

166 

VIS=VISCX(MC»-*  (VISCX  (MC  +  l)  -  VISCX  (MC)  >*FC 

RSXP 

169 

TMP  =  CX(  MC,9)MCX(  MC+i,9)-CX(  MC,9))*FC 

RSXP 

170 

c 

RSXP 

171 

c 

COMPUTE  FALL  SPEEOS 

RSXP 

172 

c 

RSXP 

1 73 

212 

CALL  TRPL ( OPST (  2  nM  ET ) » N  AT  ,ALT,PRS,P) 

RSXP 

174 

CALL  SETTLE(DPST(4,MeT) , RHOP , OEN , VIS , T MP , P , 

DN,  IACCR) 

RSXP 

175 

I F (  DN  .LT.  SRTHS  )  ON  =  0.0 

RSXP 

i.  7  S 

ZNXT=OPST(  2,M6T)+CX  <MC,2)* (UP-ON) 

RSXP 

177 

c 

RSXP 

176 

c 

HAS  THE  PARTICLE  REACHED  THE  GROUND- 

RSXP 

17  9 

c 

YES  TO  22C 

RSXP 

150 

c 

NO  TO  230 

RSXP 

181 

c 

RSXP 

162 

IF(ZNXT-ZBRSTZ)22Q, 220,230 

RSXP 

10  3 

c 

RSXP 

134 

c 

COMPUTE  OPST  TIME  OF  ARRIVAL  ON  FALLOUT  FIELD' 

RSXP 

185 

c 

RSXP 

136 

22  C 

EXT  M- (Z  BRS T  Z-DPS  T (  2 ,MBT ) ) / (UP-ON) 

RSXP 

187 

OPST ( 1 ,  MBT)  =OPST  ( 1 ,  HBT)  4-EXTM 

RSXP 

183 

OPST (  2 , M8  T)  =  ZBR  STZ 

RSXP 

16  9 

DNWAF  (MBT)  =ON 

RSXP 

19  0 

JBASE=2 

RSXP 

191 

MD  =  MC 

RSXP 

192 

GO  TO  ( 1207,233) , KB ASE 

RSXP 

193 

230 

OPST ( 1,MBT) =DPST (1 , MOT ) +CX ( MC  ,  2) 

RSXP 

194 

7LST=0PST(2,MBT) 

RSXP 

195 

OPST (2,MBT)=ZNXT 

RSXP 

196 

238 

CONTINUE 

RSXP 

197 

23  3 

GO  TO  (241,2440) ,MBT 

RSXP 

198 

c 

RSXP 

199 

c 

IF  BOTH  TOP  AND  BOTTOM  HAVE  BEEN  TREATED,  ARt  THE  TOP  ANu  BOTTOM 

RSXP 

2  jO 

c 

RADII  THE  SAME - 

RSXP 

z:  1 

c 

YES  TO  5446 

RSXP 

2  w  2 

c 

NO  TO  2401 

RSXP 

2  j  x 

c 

RSXP 

214 

241 

IF(ABSiOPST (3,1)  -  CFST (3,2))  .GT.  0.1)  GO 

TO  2441 

RS  XP 

c  o  5 

2440 

iflag=i 

RSXP 

2l  fc 

GO  TO  (  240 ,256) , MBT 

RSXP 

2.  7 

240 

I F (  IC(6)  .to.  1) 

RS'P 

2;  6 

1  WRITE! ISOUT,  777) (OPST (I ,MBT)  ,1 

=  1,8)  ,M BT  ,  1  F L  AG 

B>  XP 

2  .>9 

GO  TO  5442 

hS 

zi : 

2441 

IFl AG=2 

P 

£  .  1 

IF { IC <6 )> 2 401*240 1,2351 

RSXP 

212 

2351 

WRITE ( I SOUT, 7771  (OFS  HI , H8T ) , 1  =  1 , 8) , HBT , IFL AG 

RSXP 

213 

2401 

IF (OPST  <2* 2)- ZBRSTZ) 25 <,259, 2448 

RSXP 

214 

C 

RSXP 

215 

C 

ADJUST  WAFER  ALTITUDES  IF  THEY  ARE  IMPACTED 

RSXP 

216 

C 

RSXP 

217 

259 

OPST  ( 2  »  2)  =  OPST<2,2)  -  (CX(MCX,i>  -  DP ST (1,2))*DNWAF (2) 

RSXP 

218 

IF(DPST(2,1)  -  ZBRSTZ)  60  23, 6020, 2446 

RSXP 

219 

6020 

OPST (2*1)=  DPST (2,1)  -  (CX (MCX, 1)  -  OPS T ( 1 , 1 ) ) *0 KW AF ( 1 ) 

RSXP 

220 

C 

DETERMINE  PARAMETERS  TO  BE  USED  TO  SUBDIVIDE  A  WAFER  WHOSE  TOP 

RSXP 

221 

C 

AND  BOTTOM  HAVE  DIFFERENT  RADII 

RSXP 

222 

c 

RSXP 

223 

2446 

AL-OPST (3,1)/DPST (3,2) 

RSXP 

224 

K8=3. i 4159 Z7MD PS T*3.2>** 2 

RSXP 

225 

KDIP=AL 

RSXP 

226 

IF (K0IP-10) 2442,2442,2443 

RSXP 

227 

2443 

KDI P= 10 

RSXP 

2  28 

GO  TO  2444 

,<SXP 

229 

2442 

IF <  KOIP-2)  2450,2444,2444 

RSXP 

230 

2450 

IF ( AL-i *  5)  2451,2  452,2452 

RSXP 

231 

2451 

KDIP=i 

RSXP 

J  32 

GO  TO  2444 

RSXP 

233 

2452 

KOI P=2 

RSXP 

234 

2444 

ZO^OPST (2, 1) -DPST (2,2) 

RSXP 

235 

FK=FLOAT(KDIPI 

RSXP 

236 

□Z-ZO/FK 

RSXP 

2  37 

ALL=0.5*ZD/ALOG(Al» 

RSXP 

238 

C 

RSXP 

239 

C 

SPECIFY  PPST  ARRAYS  FOR  THE  WAFER  SUBDIVISIONS 

RSXP 

240 

C 

RSXP 

241 

DO  2445  I=1*KDIP 

RSXP 

242 

FI=FLOAT(I) 

RSXP 

243 

A=DP$T(2,2)+(FI-1.) *0Z 

RSXP 

244 

B=A4DZ 

RSXP 

245 

A1  =  AL**  (2. 0MB-DPST (2,2) )/ZO) 

RSXP 

246 

A2=  AL** (2. 0*( A-DPST (2, 2) )/ZO) 

RSXP 

247 

PPST  (2,  D-ALLMALQG  (0«5¥(A1*A2  ) )  )*DPST  (2,2) 

RSXP 

248 

PPST (3, I)=OPST (3  ,  2 )  * ( AL  ** ( (PPST (2,1) -DPST (2,2) )/ZO) ) 

RSXP 

249 

PPST (1, I)=OPST(l,MBT) 

RSXP 

250 

PPST(4,I)  =  SQRT(DPST ( 4, 1) *OPST ( 4, 2) ) 

RSXP 

251 

PPST (5, 11=0 PST (5,MBT)/FK 

RSXP 

252 

PPST (6, I)=DZ 

RSXP 

253 

pPS  T (7* I )  =A 

RSXP 

25* 

PPST (8, I)=R8*ALL*(Al-A2) 

RSXP 

255 

C 

RSXP 

256 

c 

AOJUST  PPST  ARRAY  VALUES  FOR  AN  IMPACTED  PARCEL 

RSXP 

257 

c 

RSXP 

258 

IF(PPST(2,I) .GT. ZBRSTZ)  GO  TO  3443 

RSXP 

259 

PPST(l.I)  =  CX (M  CX, 1 )  -  (ZBRSTZ  -  PPST ( 2 , 1 ) ) / ( ON WAF ( 2 )  ♦ 

RSXP 

260 

1  (ONWAF(l)  -  ONWAF (2))MPPST(2»I)  -  DPST (2 ,2 1) /ZD) 

R  5  ;<  P 

261 

PPST(2,I)=ZBRSTZ 

RSXP 

262 

PPS  T(6»I)=0«C 

RSXP 

263 

PPST (7, I)=ZBRSTZ 

RSXP 

264 

PPST(8,I)=0.0 

RSXP 

265 

G '  TO  2445 

RSXP 

266 

3443 

IF ( PPST (7,1)  ,GT.  ZBRSTZ)  GO  TO  2445 

RSXP 

267 

PFST(6,I)=PPST (6,1)  -  ZBRSTZ  PPST(7,I> 

RSXP 

2  68 

PPST (8, I ) =  PPST (8,1)  -  3.1415927*(ZBRSTZ-  PPST ( 7 , 1 > > *PPS T ( 3 , 1) 

**  2  RSXP 

269 

PPST (7, I)=Z8RSTZ 

RSXP 

270 

2445 

CONTINUE 

RSXP 

271 

94 
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5443 

IP  =  0 

RSXP 

2  72 

5445 

IP=IP*i 

RSXP 

273 

C 

RSXP 

274 

C 

SET  UP  THE  DPST  ARRAY  FOR  A  WAFER  SUBDIVISION  FROM  THE  PPST  ARRAY 

RSXP 

275 

G 

RSXP 

276 

00  5444  J=i,8 

RSXP 

277 

5444 

OPST  ( J,  H8T )  "PPST  (J, IP) 

RSXP 

278 

5442 

GO  TO  (5448,5447) , If  LAG 

RSXP 

279 

C 

RSXP 

230 

C 

SPECIFY  FINAL  OPST  AFRAY  FOR  A  WAFER  WITH  EQUAL  BASE  AND  TOP  RAOIIRSXP 

281 

C 

RSXP 

282 

5446 

OPST (6, MBT) =  OPST(2,1)-OPST (2,2) 

RSXP 

283 

OPST  (2*  H3T  )-(OPST(2,.l)+OPST  (2,2))* J. 5 

RSXP 

284 

OPST (4, H8T)=SQRT1G?S  1(4,1 >*OPST  (4,2) ) 

RSXP 

285 

OPST (7»M3T)=0PST(2,2) 

RSXP 

286 

OPST (8*M8T)=0PST (t , MBT) *3. 141 592 7* OPST ( 3 , 1 > **2 

RSXP 

28  7 

IF ( IC (6 ) ) 5447, 5447 >, 5826 

RSXP 

288 

5826 

HRITE(ISOUT,666) (0PST(I,M3T> ,1*1,8) , M3T.IFLAG 

RSXP 

289 

5447 

IF ( I  RAO)  5022,  50  22, 78  2 

RSXP 

290 

C 

RSXP 

291 

C 

RSXP 

292 

C 

INITIALIZE  FOR  HORIZCNTAL  WAFER  SUBDIVISION 

RSXP 

293 

c 

RSXP 

294 

783 

XR=BZ2 

RSXP 

295 

YR=8Z2 

RSXP 

296 

506C 

RAOIUS= OPST (3 , MB  T) 

RSXP 

297 

RAD 2= RADIUS** 2 

RSXP 

298 

5010 

IF ( RA02 -2« 0*8Z2**2) 5022,1004,1004 

RSXP 

299 

C 

RSXP 

300 

C 

RSXP 

3J1 

C 

RSXP 

332 

C 

SPECIFY  GDPST  ARRAY  FOR  WAFERS  THAT  ARE  NOT  TO  BE  SUBDIVIDED 

RSXP 

333 

C 

HORIZONTALLY 

RSXP 

304 

C 

RSXP 

305 

5022 

lODO=lOOO*l 

RSXP 

306 

GDPST ( 6 , LO DO) =DPST (2  »MBT) 

RSXP 

307 

GOPST (4,L00D)=DPSY <4,MBT> 

RSXP 

3u8 

GDPST  (3,LODO)=DPST(  i.MBT) 

RSXP 

309 

GOPST (5,LOOO)=DPST (5,M8T) 

RSXP 

310 

GOPST (1,LODD)=0« 

RSXP 

311 

GOPST (2 , LOOOI =0, 

RSXP 

312 

GDPST (7  »LOOD) =OPST ( 3  *MBT ) 

RSXP 

313 

GOPST (8 ,LOQO) =OPST (6 ,MBT ) 

RSXP 

314 

GO°S7(9,LOOD) =OPST ( 7 ,MBT ) 

RSXP 

315 

GOPST (10,1000) =  OPST (8,NBT) 

RSXP 

316 

GO  TO  5030 

RSXP 

317 

1003 

IF ( (XR) **2*(YR)**2-RA02) 1001,1001,1102 

RSXP 

318 

C 

RSXP 

319 

C 

SUBDIVIDE  WAFERS  HORIZONTALLY  AND  SPECIFY  THE  GCFST  ARRAY  DATA 

RSXP 

320 

C 

RSXP 

321 

C 

RSXP 

322 

C 

COUNT  THE  TOTAL  NUFBER  OF  HORIZCNTAL  SUBDIVISIONS 

RSXP 

323 

C 

RSXP 

324 

1004 

EX=BZ2 

RSXP 

325 

EY=BZ2 

RSXP 

326 

CNT  =4,0 

RSXP 

327 

721  C 

EX=EX+8Z 

RSXP 

328 

IF ( EX** 2+EY**2-RA02> 720 1 , 720 1, 7202 

RSXP 

329 

7201 

CNT=CNT+4.G 

RSXP 

330 

GO  TO  7210 

RSXP 

331 

95 
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72u2  EX=9Z2 

RSXP 

332 

EY=EY+BZ 

RSXP 

333 

IF (EX**2+EY**2-RAD2) 720 i , 7 201, 7 20 3 

RSXP 

334 

7203  CMA=DPST(5,MBTii/CNT 

RSXP 

335 

1001  LOOO=LOOO+1 

RSXP 

336 

LL=  LODO  +3 

RSXP 

337 

DO  11511  J=LODD , LL 

RSXP 

336 

GOP  ST  (9  ,  J)  =  OPST  ( 7  ,-M E  T  ) 

RSXP 

339 

GOPST  ( 1 0  ,  J )  ='OPST  ( 8 , XBT)  /  CNT 

RSXP 

340 

GDPST (7 , Jl =BZ2 

RSXP 

341 

GOPST (3,J)=DPST <6, MET) 

RSXP 

342 

GOPST(6,J)=OPST(2,MET) 

RSXP 

343 

G0PST(4, J)=0PST(4,HBT) 

RSXP 

344 

GOPST (3, J)=DPST (1, PET ) 

RSXP 

345 

1050  GOPST (5, J) =CMA 

RSXP 

346 

GOPST (1 ,LOQD) =  XR 

RSXP 

347 

GOPST  <2, LOGO) = YR 

RSXP 

348 

LOOQ=  LOOO+1 

RSXP 

349 

GOPS  T(l,LOOD> =  XR 

RSXP 

350 

GOPST (2 ,LOOD) =-YR 

RSXP 

351 

LOOO=  LO  OO+l 

RSXP 

352 

GOPST (l,LODD)=-XR 

RSXP 

353 

GOPST  (2,LODO)=-YR 

RSXP 

354 

LOOD=LO  DO* 1 

RSXP 

355 

GOPST(l,LOOC)=-XR 

RSXP 

356 

GOPST (2,LOOD)=YR 

RSXP 

357 

5030  IF ( LODQ-  97) 1100,1010,1010 

RSXP 

358 

1100  IF(IRAD)2585, 2585,1101 

RSXP 

359 

1101  XR=  XR+BZ 

RSXP 

3  ED 

GO  TO  1003 

RSXP 

361 

i 0  2  YR=  YR+8  Z 

RSXP 

362 

XR=  3Z  2 

RSXP 

363 

IF( YR-RADIUS) 1003,1003,2585 

RSXP 

364 

RSXP 

365 

LOAD  THE  GOPST  ARRAYS  ON  THE  CRM  OUTPUT  TAPE 

RSXP 

366 

RSXP 

367 

1010  WRITE (IRISE)LODO 

RSXP 

3  68 

WRITE (I RISE)  (GOPST (1, J),  GOPST ( 2 , J) ,GUPST(3,J),GDPST(4, 

J)  , 

GOPST (5 , JRSXP 

369 

1) , GOPST  C 6, J), GOPST ( 7 , J) ,GDPST( 8 , J) , GOPST  <9 , J ) , GCFS T (It 

, J=i,LODDRSXP 

370 

2) 

RSXP 

371 

LOOO=  0 

RSXP 

372 

GO  TO  11J0 

RSXP 

373 

2585  GO  TO  (258  ,2586),IFlAG 

RSXP 

374 

2586  IF(IP-KDIP) 5445,258,258 

RSXP 

375 

258  CONTINUE 

RSXP 

376 

278  CONTINUE 

RSXP 

377 

RSXP 

378 

LOAO  FINAL  RESIDUE  CF  GDPST  OATA  ON  THE  CRM  CUTFUT  TAPE 

RSXP 

3  79 

RSXP 

380 

1033  WRITE (IRISE)LODD 

RSXP 

361 

WRITE <1  RISE) (GDPST (1,J> , GOPST ( 2 , J) , GUPS T ( 3 , J ) ,  GOFS T (4, 

J)  , 

GOPST (5, JRSXP 

382 

1)  .GOPST  (6,  J) ,  GOPST  (  7,J)  .GOPST  (  8,  J)  .GDPST  (9,  J  ),  GCFSKlU 

,J> 

,  J  =  l,  LOCORSXP 

363 

2) 

RSXP 

36  4 

LOOO=  c 

RSXP 

365 

WRITE (IRISE)LOOO 

RSXP 

386 

ENO  FILE  IRTSE 

RSXP 

387 

REWIND  IRISE 

RSXP 

368 

RETURN 

RSXP 

369 

END 

RSXP 

390 
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♦OECK,  WNOSFT 

SUBROUTINE  WNOSFT 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  197e 

if*****************-*****  -»■»**#¥**♦***  ***  +  **#.’.-»«-**** 

THIS  PROGRAM  RE AOS  A  TAPE  C  IRISE)  OF  DATA  WHICH  DESCRIBES  AN 
AXIALLY  SYMMETRIC  STABILIZED  CLOUO  OF  FALLCUT  PARCELS 
AND  TRANSLATES  THE  HORIZONTAL  COORDINATES  OF  EACH  PARCEL 
TO  ACCOUNT  FOR  WINC  CRIFT  DURING  THE  CLUUD  RISE  1 1  ME  INTERVAL. 

IT  ALSO  APPLIES  A  TRANSLATION  OF  GZ  COORDINATES  AND  TIME. 

RESULT  IS  WRITTEN  ONTO  TAPE  JPARN  FOR  USE  BY  THE  TRANSPORT  MOGUL 


****«****♦**.***********♦ 


GLOSSARY 


OWAF(I) 

DX 


Ft/ 

IRROR 

PMAS(I) 

RV 

RWAF(I) 
TC(  I) 

TCUR 

TP(I) 

VB  ( I ) 

VC  (I) 

VT {  I) 
VWAF ( I ) 
XCCI) 

XPAR(I) 
YC(  I) 

YPAR(I) 
ZB  Cl) 

ZCCI) 


ZLOW(I) 
ZPAR(I) 
ZT  ( I ) 


PARCEL  VERTICAL  DIMENSION  (HI 

WIND-SHIFT  CORRECTION  TO  BE  ADDED  TO  THE  PARCEL  X 
COORDINATE 

WINO-SHIFT  CORRECTION  TO  BE  ADDED  TO  THE  PARCEL  Y 
COORDINATE 

STILL  AIR  PARTICLE  SETTLING  RATE 

NUMBER  OF  STATEMENT  NEAR  WHERE  AN  ERROR  WAS  DISCOVERE 
TOTAL  PARTICULATE  MASS  (KGM)  OF  PARCEL 
UPWARD  CCFPONENT  OF  VELOCITY  CF  A  STEM  PARCEL 
RADIUS  (METERS)  OF  PARCEL  AT  CENTER  CF  HASS 
TI ME ( REL ATIVE  TO  CETONATION  OFITHE  I-TH  CLOUO  RISE 
TABLE  ENTRY 

PARCEL  TIME  COORDINATE  DURING  A  WIND  DRIFT 

ADJUSTMENT  CALCULATION  INCREMENT 

TIME  OF  DEFINITION  (SEC)  OF  THE  I  TH  FARCEL 

CLOUD  BASE  VEL.  OF  THE  I-TH  CLOUD  RISE  TABLE  ENTRY 

VELOCITY  ASSOCIATED  WITH  CLOUD  AT  ZC(T)  AT  TC(I), 

CLOUO  TOF  VELOCITY  OF  THE  I-TH  CLOUD  RISE  TABLE  ENTRY 

PARCEL  VOLUME  (M**3) 

X  COORDINATE  OF  THE  CLOUD  CAP  CENTER  FOR  'ME  ITH  CLOU 
RISE  TABLE  ENTRY  AFTER  WIND  SHIFT  ADJUSTMENT 
AOJUSTEO  X  COORDINATE  OF  PARCEL  <M) 

Y  COORDINATE  OF  THE  CLOUD  CAP  CENTtR  FOR  THE  ITH  CLOU 
RISE  TABLE  ENTRY  AFTER  WIND  SHIFT  ADJUSTMENT 
ADJUSTED  Y  COORDINATE  OF  PARCEL  (M) 

CLOUD  BASE  ALT.  OF  THE  I-TH  CLOUO  RISE  TABLE  ENTRY 
(METERS  ABOVE  MSL ) 

CLOUO  CENTER  ALT.  OF  THE  I-TH  CLOUO  RISE  TABLE  ENTKY 
(METERS  ABOVE  MSL) 

PARCEL  ALTITUDE  AT  THE  BEGINNING  CF  A  WINO  DRIFT 
ADJUSTMENT  CALCULATION  INCREMENT 
ALTITUDE  CF  PARCEL  BASE  (M) 

Z  COORDINATE  OF  PARCEL  (M  ABOVE  MSL) 

CLOUO  TOF  ALTITUDE  OF  THE  I-TH  CLOUD  RISE  TABLE  ENTRY 
(METERS  ABOVE  MSL) 


COMMON  /ATMOS/  NAT,  ALT<256),  ATP(256>,  P*S(25b),  RLH(256), 

1  RHO (2  56) ,  ETA(256) »  .  MUOO*  ZV(IJJ),  V  X  ( 1 0  u ) ,  VY(13u) 

COMMON  /BASIC/  H ,FW  ,  ZBRSTZ, HEIGHT , ZSCL , SLOTMP, T PSD , XGZ ,Y GZ , T GZ 
COMMON  /CONTRL/  DE T I D (12 ) , IC ( 20 ) , IRA D, IR ISE, IS  IN , I  SCUT, JP ARN, KUI 
COMMON  /INITL/  F,  PHI,  SSAM,  TME,  TMPG,  TMPS,  VFR 
COMMON  /PA  RTCL/  NDS  TR  ,R  HCP  ,  DMEA  N  ,30  ,  PS  (2  j  j)  ,01  At’  (2f  1 )  , FM  ASS  (  20t  ) 
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WNDSF 
WNDSF 
WNDSF 
WN03F 
WNDSF 
♦♦WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
E. WNDSF 
WNDSF 
♦♦WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
0  WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
10  WNDSF 
WNOSF 
WNDSF 
I  Li  WNDSF 
WNDSF 
WNDSF 
WNOSF 
WNOSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
♦♦WNOSF 
WNDSF 
WNDSF 
WNDSF 
WNOSF 
WNDSF 
WNOSF 
WNDSF 


oooo  ooo  o o  ooo 


g^EgBgjaaffBBg 


Tjiri'.irTWiiBwn’iT 


COMMON  /TABLES/  MCX,  CX(50.10)«  GO  PS T ( 10 , 10 C» 

DIMENSION  TC ( 50 ) »  XC(50),  YC(5Q>,  ZC(50>,  VC(5j>,  ZT< 50 

1  ZB ( 50 ) ,  V8 ( 5  0  )  *  VT<50),  XPAR(liu),  YPAR(IJJ),  TP(luO), 

2  PSIZdOO),  PMAS(100»,  ZFAR(iOO),  RWAF  { 10t )  t  CWAF<100), 

3  ZLOW(lOQ),  VWAF(IOO) 

EQUIVALENCE  ( TC C 1 )  , CX (1 ,1 ) )  , ( ZT ( 1) ,CX (1 , 4 ) )  ,  (Z 0  < i> ,CX (1, 3 ) >  , 

1  l  V  8 ( 1 ) »CX (1 »  6 1 ) , ( V  T (1 ) » C  X  ( 1 , 7  ) ) ,  ( XP AR ( 1 ) , GO PST( 1) ) ,  (YPAR«1), 

2  GDrST(iOl)),  CTP(l) , GDPST <  20 1 >  > *  < PSI Z ( 1 > ,GD PS T ( 30 1 ) ) , 

3  (PMAStll  .GOPSTC  *.01»)  ,  (ZPAR ( 1 ) , GO  PS T ( 50 1 > ) ,  (RWAF  (1  ) ,  GOPS  T(  60 
4),  ( OWAF (i ) «GOPST (7  01) ) ,  ( ZLQW ( 1 >, GDPST { 80 1 >> ,  (VWAF(l) , GDPST (901 
5, (XCii) ,CXil,2) ) , (YC(1)  ,CX(1,8> ) , ( ZC (1) ,CX(1,9 ) )  ,(VC(1) ,CXC 1,10) 

OATA  PROGRM/6K WNOSF  T / 

t 

1  F0RMAT(1X,A6,I3,4E12.5,I5) 

6022  FORMAT (lH12  4X,i6HCL0(.D  TRAJ ECT0RY/6X, 2HXC, 1 2X,  2P YC, 12X , 2H ZC , 12X , 
1TC» 12X,  2HVC) 

2  FORMAT(5(iX,E13.6> ) 

4  FORMATClX,I5) 

3013  FORMAT (  /// 

1  10  X  » 1 4HBLOC K  COUNT  =  15//  ) 

1012  FORMAT  (1X»*  PARTICLE  ELOCK  BEFORE  SHI  FT*  , /8  X  ,  *X  ♦  ,  11X ,  *  Y*  ,  J.lX  ,  *T* , 
l,*PSIZ*,9X,*PMAS*,10Xf *Z*,9X,*RWAF+,8X,*0WAF*, 8X  ,*  ZLOW*  ,  8X  ,  *  VW  AF 
2//( 1X,10E12.5) ) 

3  FORMAT (1X»* PARTICLE  BLOCK  AFTER  SHIFT  * , /8X , *X *  ,  11 X , * Y* , 11X  ,  *T *, 
1, *PSIZ*,9X, *PMAS*f 10X,*Z*,9X,*RWAF*,8X,*OWAF*,6X  ,*ZLOW*, «X ,*VWAF 
2//( IX  » 1QE12  »5) ) 

♦  *********¥*■***♦»******•*♦*¥*¥•¥■♦■■.•*■■,•  •**■»♦**■***■**•*•**•»*•***¥*****»•»*****¥* 

IF(NHOOO)iOU,100 ,200 
100  I RROR=- 100 

CALL  ERRORCPROGRM, JRRCR.ISOUT) 

INITIALIZE  TAPES 
200  REWIND  IRISE 
REWIND  JPARN 

WRITE(JPARN)FW,SSAM,SLDTMP,TMSD,SD,WfHEIGHT,RHOF,CX(MCX,5>  ,Z3RST 
WRITE (JPARN)XG7-YCZ ,TGZ 
WRITE ( JPARN) (DETID(I),I=itl2> 

WRITE  (JPARN)  ND  ST  P. 

WRITE  (JPARN)  (PS(  J>  ,CIAM(  J)  ,FMASS(  J)  t  J=l,  NDSTK) 

WRITE (JPARN) NAT 

WRIT E( JPARN) (ALT ( J) ,ATP ( J) , PRS ( J ) , RL H ( J ) ,RHO(J i , ET A ( J ) , J= 1 , N AT) 


COMPUTE  CLOUO  CENTER  ANC  STEM  DRIFT  FACTOR  ENTRIES  IN  RISE  TABLE 

10  CONTINUE 

DO  25  1=1, MCX 
ZC(I)  =  (Z8(I)+ZT(I)  )/2«  3 
VC (I>= (VB(I >*VT ( I) ) /2.Q 
25  CONTINUE 

MCXP1  =  MCX  ♦  1 
MHOOQ=NHOOO-l 

ENSURE  THAT  WINO  VECTORS  ARE  DEFINED  TO  ABOVE 
STABLIZED  CLOUO  BOTTCM  ALTITUDE 

IF  ( ( ZV  (NHODO)  *ZV(MFCOO)  )/2.0  .GE.  ZB(  MCX  ))  GC  TO  2217 
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WNDSF 
WNDSF 
>,  WNDSF 
WNOSF 
WNDSF 
WNDSF 
WNOSF 
WNOSF 
WNOSF 
WNOSF 
1) WNOSF 
) ) WNDSF 
)  WNOSF 
WNOSF 
WNDSF 
WNOSF 
2H  WNDSF 
WNOSF 
WNDSF 
WNDSF 
WNOSF 
WNDSF 
9XWNDSF 
*, WNDSF 
WNDSF 
3X  WNDSF 
♦.WNDSF 
WNDSF 
WNDSF 
♦♦WNDSF 
WNDSF 
WNDSF 
'  WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSF 
WNDSFIjO 
WNDSF 101 
WNDSF 102 
WNOSF 113 
WNDSFl j4 
WNDSF 105 
WNOSF136 
WNDSF i j  7 
WNOSF136 
WNDSF lu  9 
WNDSF110 
WNDSF 111 
WN0SF112 
WNDSF 113 
WNOSF 114 
WNDSF 115 
WNDSF116 
WNOSF117 
WNOSF 118 
WNDSF 119 
WNOSF 120 


61 

62 

63 

64 

65 

66 
67 
66 
b9 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 
83 
94 
85 
o  6 
8  7 
88 

89 

90 

91 
52 

93 

94 

95 

96 

97 

98 

99 
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(J*1)+ZV(J) 1/2. u) 
31,32,32 


35,3  5,33 


IRR0R=- 26 
GO  TO  7734 

FINO  HOOOGRAPH  VECTOR  ALTITUDE  APPROPRIATE  FOR  INITIAL  TIME 

J=i 

K=1 

IF(ZC(1»-CZV  (J*1)+ZV(J) I/2.Q)  35,3  5,33 

IF ( J-NHODO)  31,32,32 

J=J+1 

GO  TO  28 

IRROR  =  -32 

GO  TO  7734 

COMPUTE  HORIZONTAL  CISPL  ACEMENTS  (/ S  •  TIME  FOR  THE  CLOUO  BOTTOM 
CENTER. 

XT  =  TC  <1)*VX(J) 

YT=TC ( 1 ) *V Y  C  J ) 

XC ( 1) =XT 
YC( 1)=YT 
TTEMP=TC(1I 
ZTEMP=ZC(1) 


WHICH  IS  LOWER,  NEXT  CLOLO  POSIT 


NEXT  HCDOGRAFH  VECTOR 


IF( j.GE.NHODO)  GO  TO  124 

IF(<ZV(J*1)  *  ZV(J)>/2.  -ZC  (K  +  l) ) 123,124,124 
0ELT=((ZV(J«1I4-  ZV(J))/2.-  ZTEMP)  /VC  (  K  > 

ZTEMP-  <ZV<J*ll*ZV<J))/2, 

TTEHP=TTEMP+OELT 
XT=  XT*  VX(J»*OF.LT 

YT= YT+  VY(J)*0ELT 

J=  J+l 
GO  TO  122 

NEXT  CLOUD  CELL  CENTER  IS  LOWER 
OEL  T=TC (K*1I-TTEMP 
TTEHP=TC(K+1) 

ZTEMP=ZC <K  +  1> 

XC(KH)  =XT  +  VX(J)  *UELT 
YC  <  K+i) =YT  +  VY (J) *DELT 
XT=  XC  ( K  +1 ) 

YT=YC(KH) 

K=K>1 

IF ( K-  MCX  )  122,125,125 

CLOUO  TFAJECTORY  IS  COMPLETE 
WRITE (ISOUT,60 22 > 

WRITE  <ISOU!T,2)  ( XC  < J  > ,Y C  (J )  ,ZC  <  J  ) ,TC  ( J  )  ,  VC (  J  ) ,  J=  1,  MCX) 

REAO(IRISE) N 
IF ( N) 13  2 , 1 02, 13  3 


ALL  OATA  HAVE  BEEN  MODIFIED.  MARK  JPARIN  COMPLETED, 


FINAL  EXIT,  ALL  OATA 
Ns  0 

IF  (IC(7  )) 2013, 2C14* 2C13 

WRITE(ISOUT,3013)N 

WRITE  C JPARN  ) N 

ENO  FILE  JPARN 

REWIND  JPARN 

REWIND  IRISE 


WNOSF121 
WNDSF122 
WN0SF123 
WNDSF124 
WN0SF125 
WNDSF126 
WN0SF127 
WNDSF128 
HNDSFl 29 
WNDSF130 
WN0SF131 
WNOSF132 
WNDSF133 
WNDSF1 34 
WNDSF135 
WNDSF136 
WNOSF137 
WNOSF138 
WNDSF139 
WNDSF140 
WNOSF141 
WNDSF142 
WNDSF1A3 
WNDSFi<«4 
WNDSF145 
WN0SF146 
WNDSF147 
WNDSF148 
WNDSF149 
WNDSF150 
WNDSF1E1 
WNDSF1E2 
WNDSF153 
WNDSF154 
WNDSF155 
WNDSF156 
WNDSF157 
WNDSF158 
WNDSF1 59 
WNOSF160 
WNDSF161 
WNDSF162 
WNCSF163 
WNDSF1 64 
WNDSF165 
WNDSF166 
WNDSF167 
WNQSF158 
WNDSF169 
WNOSF 170 
WNDSF171 
WNDSF172 
WNDSF1 73 
WN0SF174 
WNDSF175 
WNDSF1 76 
WNDSF177 
WNDSF178 
WNDSF179 
WNOSF180 
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77 34 


103 

103 


RETURN  WNDSF181 

CALL  ERROR ( PROGRM, IRRQR,ISOUT)  WNDSF182 

RETURN  WN0SF1S3 

WNDSF184 

READ  A  BLOCK  OF  N  PARTICLE  DESCRIPTIONS  WNDSF185 

REAfHIRISE  )(XPAR<J),YPAR(J),TP(J>  ,PSI  Z  (  J)  ,  PMA  S  <  J)  ,ZPAR«  J»  ,  RWAF(  J»  WNDSF136 


1,0WAF(J).ZL0W(J),VWAF<J> ,J=1,N) 

IF ( IC ( 7  I ) 2  0 15  v 2010 i 2015 
2C1 5  WRITE<IS0UT»3C13)N 

WRITE (IS OUT  ,  1C 12) (XPAR(I ) , YPAR(II*TP (I ) , PS  I Z <1 ) , PM AS ( I ) ,ZPAR(I)  , 
1RWAF<I) ,0WAF(I» .ZLCWII) » VWAF(I) ,I=1,N) 

N'JW  PREPARE 
POSITION  OF 


FIRST  INITIALIZE 
2010  OLO  Z=-99999  •  Cl 
OLDPSs-i.O 
0L0T=-1.Q 
1 


WNDSF187 
WNOSF186 
WNOSF139 
WNDSF190 
WNDSF151 
WNDSF132 

TO  SHIFT  PARTICLES  HORIZONTALLY  IN  ACCORDANCE  WITH  THEWNDSF193 
THE  CLOLC  AT  THE  TIME  WHEN  THE  PARTICLE  LtFT  THE  CLOUDWNDSF 194 

WNDSF195 

FOR  ENTERING  A  LOOP  CN  PARTICLES 


105 

WAS 

THE 

CURRENT 

(J- 

THI 

PART 

PRE 

VIOUS  ONE. 

YES 

TO 

1051 

1 J  5 

IF  ( 

TP  ( J 

l-OLDT) 10 

6,1 

0  51, 

106 

1051 

IS 

THE 

CURRENT  ( 

J-T 

H)  PAFTI 

YES 

TO 

107 

1051 

IF  C 

PSIZ 

<  JI-OLDPS 

111] 

£,107,10 

10  7 

IS 

THE 

J-TH  PART 

ICLE  AT 

THE 

YES 

TO 

108 

107 

IF  ( 

ZPAR 

i J) -OLDZI 

106 

,108 

,106 

1C  8 

THE 

“ARTICLE  WILL  HAVE 

THE 

PRE 

VIOU 

S  ONE  ANO 

WI 

LL  LEAVE 

DEFINED  AT  THE  SAME  TIME  AS  THE 


THE  SAME  SIZE  AS  THE  PREVIOUS  ONE 


SAME  ALTITUDE  AS  THE  PREVIOUS  ONE. 


10  3 
1C  9 


THE 

TUOE  AS  THE  PREVIOUS  ONE.  ADOITION  OF 

PELATIVE  TO  COORDINATE  SYSTEM  ORIGIN 

TP( J)sTP(J) *TGZ 

XPARI  J)  -  XPAR(J)  4-DX+XGZ 

YP4R( J) =YPAR<  J» ♦ 0 Y ♦ Y G Z 


HORIZONTAL  DISPLACEMENTS  AS  THE 
CLOUD  AT  THE  SAME  TIME  ANO  ALTI- 
XGZ, YGZ  MAKES  XPAR,  Y PAR 


ANO  TEST  J 
NEXT  8L0CK 


INCREMENT 
FETCH  THE 
J  =  J  +  1 

IF(J-H) 105,135,  ilC 


TO 

OF 


CONSIDER 

PARTICLE 


THE  NEXT 
OATA. 


PARTICLE  OR  RETURN  70 


110  PUT  THE  MODIFIED  OATA  CN  THE  TAPE  JPAPIN  ANO  THEN  RETURN  TO 
FETCH  THE  NEXT  OATA  BLOCK, 

110  WRITE ( JPARN  IN 

WRITE  (JPARN  ) (XPAfi (J), YFARIJI ,Zf AR« J) , TF(J> ,PS1Z( Jl ,PMA3( J> ,RWAF 
1 ( Jl  ,  OWAF ( J) ,7LOW(J) , VWAF( J)  ,J=i,N> 

IF(IC<7>li85,i04,i85 
185  WRITE  <ISCUT,UN 

WRITE  <ISOUT,3)  <XPAR(  I),  YFAR(I)  ,  TF(I5  ,PSIZ(II  ,PMAS(I)  ,ZPAR(II  , 
IRWAF(I) , DWA  F ( I ) *  ZLGW (I)  ,VWAF(I) ,1  =  1, N) 

190  GO  TO  104 
1C  6  OLDPS=PSIZ ( J» 

OLD  2-  7.P  AR<  J  l 
OLOT^TP (J) 


DIO  J-TH  PARTICLE  LEAVE  THE  CLOUD. 


Nl  TO  115 


WNDSF1 96 
WNDSF197 
WN0SFxs3 
WNOSr 199 
WNDSF20U 
WNOSF231 
HNDSF2C2 
HN05F213 
WNDSF2Q4 
WNDSF2C5 
WNDSF236 
WNDSF  237 
WNDSF208 
WNDSF2  J9 
WNDSF21D 
WNOSF211 
WNDSF212 
WNDSF21 3 
WNCSF214 
WND3F215 
WN0SF21G 
WNOSF217 
WNDSr216 
WNOSF215 
WNDSF22C 
WNDSF221 
WNDSF222 
WNOSF223 
WNQSF224 
WNDSF225 
WNDSF 2 26 
WND3F227 
WNDSF226 
WNDSF229 
WNOSF230 
WNDSF231 
WMDSF232 
WNDSF233 
WNDSF  234 
WNDSF235 
WNDSF 2 36 
WNDSF  237 
HNOSF238 
WNDSF  2  39 
WNDSF240 


ooo  ooo  oo  ooo  ooo  o  oooo  oo 


IF ( ZPAR ( J)  -Z8  (  MCX  ))  114,115,115 

".15  TAKE  CARE  OF  PARTICLES  THAT  QQNT  LEAVE  THE  CLOUD 
.15  DX=XC(MCX> 

0 Y= YC { MG  X ) 

T  P  <  J )  ANO  ZPAR(J)  ARE  OK  AS  IS. 

GO  TO  108 

114  THE  PARTICLE  HAS  LEFT  THE  CLOUD 
114  ZCUR=ZPAR(JI 

IF <  ZCUR  .LT.  Z8RSTZ  )  ZCU«=ZBRSTZ 
TCUR=  TP  ( J) 

DX=  0. 

DY=0. 

COMPUTE  ATMOSPHERE  PROPERTIES  AT  ZCUR 
CALL  TRPL(ZCUR,NAT, ALT, ATP, T> 

CALL  TRPL( ZCUR, NAT , ALT, PRS,P> 

CAuL  TRPLIZCUR.NAT, ALT,RHO,DEN) 

CALL  TRPL( ZCUR, NAT , ALT, ETA, VIS) 

LOCATE  PARTICLE  OEFIMTICN  TIME  IN  THE  CLOUD  RISE  TABLE. 

OO  210  K-i , MCX 
LL=MCXP1-K 

IF<TC<LLI.LE.TP<J>)  GO  TO  221 

210  CONTINUE 

211  IRR0R=-2il 
GO  TO  Z734 

221  LOCATE  INITIAL  PARTICLE  ALTITUDE  IN  THE  WIND  HOGOGkAPH  TABLE 
221  DO  230  K=1 , MHODO 

IF(  (ZVCK)*ZVCK*1))/2.0.GT.ZPAR(  JHGO  TO  24 0 
230  CONTINUE 
MM=  NHODO 
GO  TO  223 
240  MM=K 

220  FIND  CLOUO  BOTTOM  ALTITUDE  AT  THE  PAkTICLE  DEFINITION  TIME 
220  ZBOTOM=  ZE(LL)  ♦ ( TP < J) -TC ( LL >> * V9 ( LL > 

IF i  (ZBOTOM-  ZCUR). LE.  115. *W**(J. 151) )  GO  TO  22  5 

LOCATE  INITIAL  PARTICLE  ALTITUDE  IN  THE  CLOUD  RISE  HISTORY  TABLE 


WNDSF2h1 
WNOSF242 
WNDSF243 
WNDSF  244 
WN0SF245 
WNDSF246 
WNDSF247 
WNDSF248 
WNDSF249 
WNDSF2  50 
WN0SF251 
WN0SF252 
WN0SF253 
WN0SF254 
WNUSF255 
WNDSF  2  56 
WNDSF  2  57 
WNDSF258 
WNDSF259 
WNDSF260 
WNDSF261 
WN0SF262 
WNDSF263 
WNDSF264 
WNDSF265 
WNOSF266 
WNDSF2  E7 
WNDSF268 
WN0SFZ69 
WNDSF270 
WNDSF271 
WNOSF272 
WNDSF273 
WNDSF274 
WNDSF  275 
WN0SF276 
WN0SF277 
WNDSF278 
WN0SF279 
WNDSF2  30 
WNDSF2S1 
WNDSF282 
WNDSF 2o 3 
WNDSF  234 
WNGSF285 


DO  222  K=1 «MCX 
NN=MOXP 1-K 

IF(Z8(NN)  .LE.ZGUR)  C-CTO  224 
222  CONTINUE 


WNOSF28F 
WNDSF  23 7 
WNDSF 2 08 
WNDSF289 
WNDSF29C 


COMPUTE  AN  AVERAGE  BASE  RATE,  BV 

WNDSF 291 

WNOSF292 

224 

If"(  LL  .GT.NN)  GO  TO  3224 

WNDSF293 

9V= V8(LL) 

WNDSF294 

GO  TO  3227 

WNDSF  29  5 

322  4 

3  V=  0  « 

WNDSF296 

OO  3225  K=NN,LL 

WNDSF  297 

IF ( K.EQ.  MCX  )  GO  TO  3226 

WNDSF2 36 

3225 

8  V=  BV  *VB(KJMTC<K*1>-  TC(K>> 

WNDSF299 

3226 

BV=  BV/(TC{LL)-TC(NNI) 

WNDSF3wQ 
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3227  CALL  SETTLE (PSIZ (J)  , WHOP , DEN, VIS ,T ,P ,F V , IACCR) 

CAN  THE  PARTICLE  BE  MOVEC  SIGNIFICANTLY  IN  THE  TINE  AVAILABLE-  — 
YES  TO  250 
NO  TO  315 

IFCC  ZBOTOM-ZCUR+IO . O.LT. ( TP ( J) -TCCl) )* (FV  +  BV) )  GO  TO  250 
225  OELTEE=0. 

GO  TO  315 

INOEX  MM  IDENTIFIES  THE  WINO  HQOCGRAPH  STRATUM  IK  WHICH  THE 
PARTICLE  IS  CURRENTLY  OEFINEO. 

INOEX  LL  IOENTFI ES  THE  CLGUQ  RISE  HISTORY  TABLF  ENTRY  WHICH 
REPRESENTS  THE  RISE  INCREMENT  OURNING  WHICH  THE  PARTICLE  IS 
CURRENTLY  OEFINEO. 

£45  LOCATE  CURRENT  PARTICLE  ALTITUDE  IN  THE  WI KO  H  OOOGRAPH  TABLE 

245  00  246  K=i,MHODO 

IF(  (ZV(K)  «-ZV  (<♦!))/  2.  C  .GT.  (ZCUR+  1.0UGQ  TO  247 

246  CONTINUE 
MM=  NHOOO 
GO  TO  250 

247  MM=K 

250  CONTINUE 

DETERMINE  IF  NET  PARTICLE  MOTION  IS  UPWARD  OR  00  KNWAKD • 

UPWARD  TO  251 

CALL  SETTLE (PSIZ ( J)  , RHOP ,OEN , VI S , T , P ,F V ,1 ACCR) 

OOWNWARC  TO  253 

IF( (ZBOTOM-ZBRSTZ)  .GT.O.G)  GO  TO  2296 

2297  RV=0. 

GO  TO  2299 

2298  RV  =  V3t!LL>M  i.OM  ZCUR-ZBOT  OM)  /  (  ZBOTOM-ZBRSTZ)) 

IF  (  ABS(RV)  .GT.  ABS(VBCLD)  )  RV=VB<LU 

2299  IF(FV-RV  .GE.C.O)GO  TO  253 

251  COMPUTE  THE  TIMES  RECUIRED  FOR  THE  PARTICLE  TO  MCVE  TO  THE 
BOTTOM  OF  THE  HODOGRAPH  STRATUM  IN  WHICH  IT  RESIDES, ANO  TO  THE 
BASE  OF  THE  CLOUC.  USE  THE  SMALLER  OF  THESE  TIMES. 

251  IF ( ( MM-1) • GT. 0 )  GO  TO  252 
OELZEE=  Z8RSTZ-ZCUR 

GO  TO  1253 

252  OELZEE=  (ZV(MM)  +ZV(MM-i>>/  2.0-ZCUR 
IF ( OELZEE  .LT.  -O.CDGO  TO  1253 
MM=MM-1 

GO  TO  251 

1253  0ELTEP=  DEL  ZEE/ < FV- F V) 

254  0ELTEE= <  Z8 OTOH-ZCUR )  / <FV -RV +V3  <  LD ) 

IF  C  OELTEE.LT.  OELTEF)  GO  TO  255 
DEL  TGE=  OELTEP 

255  IFCOELTEE.GE.O.C)  GC  TO  278 

256  IRROR=- 256 
GO  TO  7734 


WNDSF  3  j 1 
WNOSF  3  j  2 
WNDSF3Q3 
WN0SF3C4 
HNOSF3Q5 
WNDSF3I6 
WN0SF3J7 
WN0SF338 
WNDSF309 
WNDSF310 
WNDSF311 
WN0SF312 
WN0SF313 
HNDSF314 
WN0SF31 5 
WN0SF316 
WNDSF  317 
WNDSF318 
WN0SF319 
WNDSF32Q 
WNDSF321 
WNDSF  322 
WNDSF323 
WN0SF324 
WNDSF325 
WNDSF326 
WNDSF  327 
WN0SF328 
WNDSF329 
WNDSF 330 
WNDSF331 
WNOSF332 
WNDSF3  33 
WNOSF334 
WNDSF335 
WNDSF  3  36 
WNDSF3  3  7 
WNOSF  338 
WNOSF  339 
WNDSF3>40 
WNDSF341 
WN0SF342 
WNDSF  3  43 
HN0SF344 
WNOSF345 
WNOSF346 
WNOSF347 
WNDSF3  48 
WNDSF349 
WNDSF  350 
WNOSF  3  51 
WNDSF3  52 
WNDSF353 
WNOSF354 
WNOSF 3 55 
WND3F356 
WNOSF357 
WNDSF  358 
WNOSF359 
WNDSF360 
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253  COMPUTE  THE  TIMES  REQUIRED  FOR  THE  PARTICLE  TO  MCVE  TO  THE  TOP  OF 
THE  HOOOGRAPH  STRATUM  IN  WHICH  IT  RESIDES. ANO  TO  THE  BASE  OF  THE 
CLOUO.  USE  THE  SMALLER  CF  THESE  TIMES. 

253  0ELTEP=  <<ZV(MM)«-  ZV  CMM+1)  ) /2.C  -ZCU R) / ( FV-RVI 
GO  TO  254 

278  TMIU0T=TCUR-PELT£E 

IF  ( IC  (8  )  .EQ.O  I  GO  TO  2/9 
IAC=278 

WRI T  £  ( I S OU  T ,  2  3 1 0  I IAC, 

1  J.LL.MM.LLL.OELTEE. ZBOTOM ,Rtf » FV  ,TCUR, ZCUR, TMIUDT 

2310  FORMAT SI5/ 

1  415/ 7( 3X. E12. 5) ) 

FIND  THE  POSITION  OF  TIME  TMIUDT  IN  THE  CLOUC  RISE  TABLE. 

279  LLL-LL 

28 C  IF(TC(LLI.LE. TMIUDT)  GO  10  290 
LL=LL-1 

IF(LL.GE.l)  GO  TO  280 
TMIUOT=  TC(1) 

LL=  1 

DEL  TEE=  TCUR-TC ( 1) 

COMPUTE  THE  CLOUO  80TT0M  HEIGHT .Z30T0M , AT  THE  TIME  TMIUDT. 

290  Z90T0M=ZB(LL»  *VB  CLL)  ♦(THIUOT-TC  (LdI  I 

IS  THIS  CLOUD  BOTTOM  ALTITUDE  DESS  THAN  CR  EQUAL  TO  THE  PARTICLE 
ALTITUDE- 

YES  TO  295  OR  320 
NO  TO  300 

291  TMPDZ=Z80T0M-ZCUR- (F V-RV) *OELT£E 
IF (ABS<TMP0Z) .LE.5. 0)  GO  TO  320 
IF(TMPDZ)295,320,300 

295  CLOUO  BASE  AND  PARTICLE  TRAJECTORIES  HAVE  CROSSED.  IF  POSSIBLE, 
GO  BACK  TO  THE  STEP  JUST  BEFORE  THE  CROSSING  OCCURS. 

295  LL=LL+1 

IF(LLL-LL) 296, 310,297 

296  LL=LLL 

GO  TO  3  13 

297  OELTEE*  TCUR-TCCLLI 
780T0H-*  ZB(  L LI 

TMPOZ=ZBOTOM-ZCUR-(F  V-R  Y)  4D  ELTEE 
IF (ABS( TMPOZ) .LE.5.0  I  GO  TO  311 
IFCTMPOZI295,  311,300 

300  INCREMENT  PARTICLE  SHIFT  PARAMETERS 
300  OX=  OX  +  Y  X (  MMI  *DELTE£ 

OY=  OY+V  Y (  MM)  ♦OELTEE 
TCUR=TCUR-OELTEE 
ZCUR=ZCUR*  CFY-Rtf )*OELTEE 
3  COMPUTE  ATMOSPHERE  FRO  FERTIES  AT  ZCUR 
CALL  TR PL (ZCUR, NAT, ALT, A  TP, Tl 
CALL  TRPL< ZCUR, NAT  ,ALT,PRS, PI 
CALL  TRPL(ZCUR,NAT, ALT,RHO,DEN) 


WN0SF361 
WN0SF362 
WNDSF3  63 
WNDSF364 
WNDSF365 
WNDSF366 
WN0SF367 
WNDSF368 
WNDSF369 
WNDSF370 
WNDSF3  71 
WN0SF372 
WNOSF3  73 
WN0SF374 
WNDSF375 
WNDSF376 
WN0SF377 
WNDSF378 
WNDSF379 
WNDSF360 
WN0SF381 
WNDSF382 
WN0SF383 
WNDSF384 
HNDSF385 
WNOSF386 
WNDSF387 
HNDSF368 
WNDSF389 
WNDSF390 
WNDSF391 
WNOSF392 
WNDSF393 
WNDSF394 
WNOSF395 
WNDSF396 
WN0SF397 
WNDSF398 
WN0SF399 
WNDSF43  0 
WNDSF431 
WNDSF4J2 
WNOSF403 
WN0SF4C4 
WNDSF405 
WNCSF406 
WNDSF4C7 
WNDSF436 
WNDSF4J9 
WNOSF410 
WN0SF4U 
WN0SF412 
WNDSF413 
WNOSF414 
WNDSF415 
WNDSF416 
WNDSF417 
WNDSF418 
WNDSF419 
WNOcc  420 
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CALL  TRPL(ZCUR,NAT, ALT,ETA,VIS) 

IF  ( IC  (8  )  .  EQ.C  )  GO  TO  245 
I AC=30  0 

WRITE (I  SOU  T  «2310) I  AC  , 

1  J,LL,MM,LLL,0£LT£E-.ZBGTOM,RV,FV,TCUR,ZCUR,TNIUDT 

GO  TO  245 


318  HAKE  FINAL  ADJUSTMENTS  TO  PARTICE  SHIFT  PARAMETERS. 


310  Z80T0M=Z8(  LL)*VB<  LL  >*  ( TCUR-TC  (  LDI 
DEL T£E= (ZBQTOM-ZCUR)/(VB (  LL)-RV+FV> 

311  IF ( OELTEE.LT.  0. 0) D ELTEE=Q . 

IF  C (TCUR-D ELT EE)  .LT  .  0.0)  OELT£E  =  J.O 
315  IF (TO  (LL )  .LE.  ( TCUR- CELT  EE- b. 1 ) )  GO  TO  320 
LL=  LL-1 

IF(LL.GE.l)  GO  TO  315 
LL=1 

320  OELTRP  =(TCUR  -OELTEE-TC (  LL))/(TG(  LL+1)  -TC(  LL»5 
322  DX  =  OX«-VX(  MM)  *DELT  EE  «•  XC<  LL)  ♦  (XC(  LLMi  -XC(  LL)  )  *0  ELTRF 
O Y=  DY  +V Y (  MM)*OELTEE  +  YC(  LL)  +  (YC(  LLn)  -YC<  LL)>*DELTRF 
IF(ICCe)  . EQ . 0 ) GO  TO  108 
IAC=32Q 

WRITE(IS0UT,231G)IAC, 

1  J,LL,MM,LLL,OELT£E,ZBOTCM,RV, F  V  ,T  CUR ,  ZC  UR, TMiUOT 


GO  TO  1C8 


END 


WNDSF421 

WN0SF422 

WNDSF423 

WN0SF424 

WNDSF425 

WNDSF426 

WN0SF427 

WN0SF426 

WN0SF429 

WND3F430 

WNDSF431 

WN0SF432 

WNDSF433 

WN0SF434 

WN0SF435 

WNDSF436 

WNDSF437 

WN0SF438 

WN0SF439 

WNDSF440 

WNDSF441 

WN0SF442 

WNDSF443 

WNDSF444 

WNDSF445 

WNDSF446 

WNDSF447 

WNDSF448 

WNDSF449 


DECK*  AOVEC  AOVEC 

SUBROUTINE  AD VEC ( N£ T  ,NE TSU , ZBH , T INUP , USUM , V SUM , DXS UN, DYSUM,RSUM,  AO  VcC 
1WFZ,TSUM,CAVS,ZCH,ALT,ATP,PRS,RH0,ETA,TMAX,  AO VEC 

2ICF, JCF,NCF,KBHFf N  tA  IF, L TIME, NATF)  AO VEC 

AO  VEC 

H,  G.  NORMENT,  ATMCSFHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  AD VEC 

AD  VEC 


***********  ***************************************  **  ****************  **  AO VEC 

AO  VEC 

FALLOUT  PARCELS  ARE  TRANSPORTED  (VIA  SR  TRANF)  BY  AOVECTION  PLUS  AOVEC 
SETTLING.  PARCEL  TCF  ANO  BASE  ARE  TRANSPORTED  SEPARATELY,  AND  THE  AOvEC 


RESULTS  ARE  SMEARED.  THE  /COMMON/  VARIABLE  ZP  IS  REDt-FlNEO.  AOVEC 

AOVEC 

********«**************.****«******************#****  *******************  AOVEC 

AOVEC 

COMMON  /CNTROL/  I  POUT , IS  IN, I SOUT , JPARN , MC ( 20 ) , NS EQO  AOVEC 

COMMON  /PARCL/  CRCS S, DOWN , OWAF ,ED DY ,NO ATP , PMA S , PSIZ , RHOP, RW AF,  AOVEC 
1  TP,XP,YP,ZLOW,ZP  AOVEC 

COMMON  /SPACE/  MINT, XLLC  ,YLLC,ZMAX,Z MI N, TIMEX  AOVEC 

C  AOVEC 

DIMENSION  NET ( ICF, JCF) , NETSU ( NCF > , ZB H ( K 8HF >  ,03 UK ( KBHF , ND AT F , LT IMF* AOVEC 
DIMENSION  VSUH (KBHF, RDATF,LTIMF) ,DXSUM (KBHF, NOATF, LTIMF)  AOVEC 

DIMENSION  DYSUM(KBHF  ,NDATF,LTIMF.‘,TIMUF(LTIMF)  »ZCH(K0HF)  AD  VEC 

DIMENSION  CAVS(KBHF) ,WFZ ( KQHF , NO ATF, lTIMF ) ,TSUM(KBHF>  aDVEC 

DIMENSION  RSUM(K8HF,K0ATF,LTIMF)  AOVEC 

DIMENSION  ALT(NATF) , ATP (NATF), PRS< NATF) ,RHC( NATF), ETA (NATF)  AOVEC 


1 

2 

3 

4 

5 

6 

7 

8 
9 

ID 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 
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c 

DATA  EPS/0.1/ 

C 

MC3=MC( 3) 

CHANGE  ZP  FROM  PARCEL  CENTER  TO  PARCEL  BASE  ALTITUCE. 

ZP=ZLOW 

CALCULATE  TRANSPORT  OF  PARCEL  BASE. 

IF  (  (ZP-ZMIN)  .GT.EPS)  GO  TO  1411 

TOL  =TP 

XOL  =XP 

YOL=YP 

ZOL  =ZP 

ROL=0. 

SIGXL=RWAF 
SIGYL=RWAF 
GO  TO  1412 

1411  CALL  TRANPtN  ET,NETSU, ZBH, TIM  UP , USUM , VSUM  ,CXSUM,DYSUM, RSUM, 

1HFZ,CAVS*T5UN,TMAX,  XCL,  YOL,  ZOL ,  TOL  *  SIGXL  ,  SI  GYL  ,  R  CL  ,NOATL  , 
2ICF,JCF,NCF,KBHF,N0ATF,LTIMF) 

CHANGE  ZP  FROM  PARCEL  BASE  TO  PARCEL  TOP  ALTITUDE. 

1412  ZP=  ZLOW  +  DW AF 

CALCULATE  TRANSPORT  OF  PARCEL  TOP. 

I F (  ZP-ZMIN  .GT.EPS)  GO  TO  1414 

TOU=TP 

XOU=XP 

YOU= YP 

ZOU=ZP 

ROU=0. 

SIG  XU=R  WAF 
SIG YU=RWAF 
GO  TO  1415 

1414  CALL  TRANP(NET,NETSU,Z3H,TIMUP,USUM,  VSUM , CXS LM , OYSUM , RSUM, 

1  WFZ,CAVS,TSUM,TMAX,XCU,  YO U, ZOU , TOU ,SIGXU , S 1G YU  ,RCU  ,NQATU, 

2ICF, JCF,NCF,KBHF, NCA  IF,  LTIMF) 

CALCULATE  SMEAR  OF  PARCEL  TOP  AND  BASE  RESULTS. 

1415  Z0UTN=(Z0L+Z0U)/2. 

T0UTN=(T0L+T0U)/2. 

IF(A3S< XOU-XOL). GE. 1.0E-20)  GO  TO  1404 
IFtABS(YOU-YOL) .GE, 1.0E-30 )  GO  TO  1403 
pOU TN=0  . 

GO  TO  1405 

1403  ROUTN=l. 57079633 
GO  TO  1405 

1404  ROUTN=ATAN( (YOU-YOL ) / (XOU-XOL) ) 

IF (XOU-XOL  .LT.  O.t)  ROUTN=ROUTN  -  S IG N ( 3. 1415 92 £54, ROUTN) 

1405  R=ROUTN-ROL 

SXL  =1 . /SQRT ( (COS (R) /SIGXL) **2t ( S I N <R > / SIG YL ) **  2) 

SYL=1./SQRT( (SIN (R) /SIGXL ) *  *  2+ ( C OS (R ) / SI GYL ) ** 2 ) 

R=ROUTN-ROU 

SXU  =  1./SQRT  (ICOS(R)  /SIG  XU)  *+ZH  SIN  CR) /SIGYU )  **  2  ) 

S  YU  =  1 .  /SQRT  ( (SIN  (R)/SIGXU)**2+(CCS(R)/SIGYU)**2) 

SXOTN=(5jXU  +  SXL4-SQRT  C  (XOU-XOL)  **2+(  YOU-YOL)  )  /2. 

SYOTN=SQRT(SYU*SYL) 

XOUTN=XOL* (SXOTN -SXL) *CO  £( ROUTN) 

YOU TN- YOLMSXOTM-SXL)*SIM ROUTN) 


AOVEC 

27 

AOVEC 

28 

AOVEC 

29 

AOVEC 

3  C 

AOVEC 

31 

AOVEC 

32 

AOVEC 

33 

AOVEC 

34 

AOVEC 

35 

AOVEC 

36 

AOVEC 

37 

AOVEC 

38 

AOVEC 

39 

AOVEC 

40 

AOVEC 

41 

aOVEC 

42 

AOVEC 

43 

AOVEC 

44 

AOVEC 

45 

AOVEC 

46 

AOVEC 

47 

AOVEC 

43 

AOVEC 

49 

AOVEC 

50 

AOVEC 

51 

AOVEC 

52 

AOVEC 

53 

AOVEC 

54 

AOVEC 

55 

AOVEC 

56 

AOVEC 

57 

AOVEC 

58 

AOVEC 

59 

AOVEC 

60 

AOVEC 

61 

AOVEC 

62 

AOVEC 

63 

AOVEC 

b4 

AOVEC 

65 

AOVEC 

66 

AOVEC 

67 

AOVEC 

68 

AOVEC 

69 

AOVEC 

70 

AOVEC 

71 

AOVEC 

72 

AOVEC 

73 

AOVEC 

74 

AOVEC 

75 

AOVEC 

76 

AOVEC 

77 

AOVEC 

78 

AOVEC 

79 

AOVEC 

60 

AOVEC 

61 

1450  CALL  OUMPER (XOUTN.YCITN, ZOUTN,TCUTN, SXOTN, SYCTN,PMAS,PSIZ , ROUTN, J, AOVEC  62 

llSOUT , I  POUT  ,MC3)  AOVEC  £3 

RETURN  AOVEC  64 

END  AOVEC  35 
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♦DECK, SOU M 

SUBROUTINE  80UN(NET  ,NETSU, X T , YT , XO , YO, XC , YC » 1CF,  JCF.NCF) 

C  MARCH,  197 1 

SUBROUTINE  BOUN  OET ERHINES  AN  INTERPOLATED  PARCEL  POSITION 
(INFINITESMALLY  DISPLACED  EXTERNAL  TO  A  CELL  3  fUNOARY)  G  IVEN  THE 
PREVIOUS  PARCEL  POSITION  INTERNAL  TO  THIS  CELL  AND  THE  ANTICIPATE 
PARCEL  POSITION  EXTERNAL  TO  THIS  CELL 
XT  -  ANTICIPATED  PARCEL  POSITION  X  COORDINATE 

YT  -  ANTICIPATED  PARCEL  POSITION  Y  COORDINATE 

XO  -  PREVIOUS  PARCEL  POSITION  X  COORDINATE 

YO  -  PREVIOUS  PARCEL  POSITION  Y  COORDINATE 

XC  -  INTERPOLATED  PARCEL  POSITION  X  COORDINATE 

YC  -  INTERPOLATED  PARCEL  POSITION  Y  COORDINATE 


YT 

XO 

YO 

XC 

YC 

AOISP  - 
BOISP  - 


AOISP  -  SMALL  X  DIS P LACE  RENT .  ♦  CR  -  EPS. 

BDI Sp  -  SMALL  Y  DISPLACEMENT.  ♦  OR  -  EPS. 
DIMENSION  NET  <ICF,JCF},NETSU(NCF) 

DATA  EPS/0.5/ 

CLEAR  AOISP  AND  BOISP 
ADISP=0 . 

BDISP=0 . 

COMPUTE  XL »  XR *  YL  »  AND  YU  F CR  (XO,YO) 

CALL  NEST J NET, NETSU  ,XO ,YO , NDA TO , XL ,XR,YL;YU, 
CUT  AND  TRY  XC 

CHECK  IF  XT  LIES  TO  THE  RIGHT  Or  XR 
IF ( XT .LE.XR)  GO  TO  102 
XC=XR 
ADISP=EPS 
GO  TO  104 

CHECK  IF  XT  LIES  TO  THE  LEFT  OF  XL 
102  XC=XL 

IF(XT.GEiXL)  GO  TO  106 
ADI SP=- EPS 
C  CMPUT  E  YC 

104  YC=YO*( YT-YO) *  « XC-XO )/<XT-XO) 

CHECK  IF  YC  LIES  BETWEEN  YL  AND  YU 

TFC  (YU.  GE.YDJ  .AND  .(  YC.GF,.  YD  >  GO  TO  111 
CUT  AND  TRY  YC 
CHECK  IF  YT  l  IES  ABOVE  YU 
106  IF(YT.LT.YU)  GO  TO  106 
YC=YU 

107  BDI SP=E PS 
GO  TO  110 

CHECK  IF  YT  LIES  BELOW  YL 
106  YC= YL 

IF(YT.GT.YL)  GO  TO  111 
BOISP=-EPS 
C  OMPUT £  XC 

110  XC=XO+<  XT-XGJMYC-YCS/CYT-YO) 

CREATE  INFINITESMAL  DISPLACEMENT 

111  XC^XC+AOISP 
vC=YC«-BDISP 
RETURN 

END 


ICf,JCF,NCF> 
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1 
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2 
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3 

BOUN 

4 

BOUN 

5 

BOUN 

6 

BOUN 

7 

BOUN 

6 

BOUN 

9 

BOUN 

10 

BOUN 

11 

BOUN 

12 

BOUN 

13 

BOUN 

14 

BOUN 

15 

BOUN 

16 

BOUN 

17 

BOUN 

le 

BOUN 

19 

BOUN 

20 

BOUN 

21 

BOUN 

22 

BOUN 

23 

BOUN 

24 

BOUN 

25 

BOUN 

26 

BOUN 

27 

BOUN 

28 

BOUN 

29 

BOUN 

30 

BOUN 

31 

BOUN 

32 

BOUN 

33 

BOUN 

34 

BOUN 

35 

BOUN 

36 

BOUN 

37 

BOUN 

38 

BOUN 

39 

BOUN 

40 

BOUN 

41 

BOUN 

42 

BOUN 

43 

BOUN 

44 

BOUN 

45 

BOUN 

46 

BOUN 

47 

BOUN 

48 

BOUN 

49 

BOUN 

50 

BOUN 

51 

BOUN 

52 

BOUN 

53 
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♦OECK, 

CALIB 

CALIB 

1 

SUBROUTINE  CALIB ( A, NX, AN, NS ,N> 

CALIB 

2 

C 

MARCH,  1971 

CALIB 

3 

c 

SUBROUTINE  CALIB  DETERMINES  A  JUSTIFIED  INDEX  WHICH 

RELATES  *N 

CALIB 

4 

c 

INPUT  DATA  POINT  TO  ITS  CORRESPONDING  POSITION  IN  AN  INPUT 

ARRAY. 

CALIB 

5 

c 

CALIB 

6 

c 

A  -  INPUT  OATA  ARRAY 

CALIB 

7 

c 

NX  -  INPUT  MAXIMUM  INCEX  OF  A 

CALIB 

8 

c 

AN  -  INPUT  DATA  POINT 

CALIB 

9 

c 

NS  -  INDEX  JUSTIFICATION  COOE.  WHEN  GIVEN  (BY 

INPUT) 

THE 

CALIB 

10 

c 

FOLLOWING  VALUES,  N  IS  DETERMINED  SUCH  THAT  - 

CALIB 

11 

c 

♦  1  A  ( N)  IS  .LE.  AN 

CALIB 

12 

c 

-1  ACN)  IS  .GT.  AN 

CALIB 

13 

c 

N  -  OUTPUT  INDEX 

CALI  3 

14 

c 

CALIB 

15 

DIMENSION  A (NX ) 

CALIB 

16 

EPS  =  l.E-6  *  NS  *  ABS (  AN  ) 

CALIB 

17 

N=0 

CALIB 

18 

COMMENCE  SEARCH  FOR  N 

CALIB 

19 

1 

N=N  +  1 

CALIB 

20 

NN=N+(i*NS!/2 

CALIB 

21 

COMPARE  A  ( NN)  WITH  AN  ONLY  IF  NN  IS  LESS  THAN  NX4-1 

CALIB 

22 

IF(  (NN.LT.NX+D.ANC. (ACNNI.LT. AN4EPSM  GO  TO  1 

CALIB 

23 

RETURN 

CALIB 

24 

END 

CALIB 

25 

* 

OECK, 

CNTR 

CNTR 

1 

SUBROUTINE  CNTR (NET ,N ETSU, N DATA , XG , Y G, ICF , JCF, NCF) 

CNTR 

2 

C 

MARCH,  1971 

CNTR 

3 

c 

SUBROUTINE  CNTR  DETERMINES  THE  X,Y  COORDINATES  AT  THE  CENTER  OF 

A  CNTR 

4 

C 

HORIZONTAL  SPACE  RESOLUTION  MESH  OR  SUB-MESH. 

CKTR 

5 

C 

NDATA  -  ATMOS.  HORIZ.  SPACE  NET  MESH  OR 

SUB-MESH  INDEX 

CNTR 

6 

C 

XG  -  NET  MESH  OR  SUB-MESH  CENTER  POSITION  X  COORDINATE 

CNTR 

7 

c 

YG  -  NET  MESH  OR  SUB-MESH  CENTER  POSITION  Y  COORDINATE 

CNTR 

8 

COMMON  /CNTROL/  IPO U T, I  SI N, 1  SO UT , JPARN , 

MC( 20),  NSEQO 

CNTR 

9 

COMMON  /INDEX/  ICX , JCX, KBHX , LT IMX , NAT , NCX ,NDAT X 

CNTR 

10 

COMMON  /SPACE/  H IN T  ,  XLLC , YLLC , ZM AX , ZMI N 

, TIMEX 

CNTR 

11 

DIMENSION  NET ( ICF, JCF) , NETSU (NCF ) 

CNTR 

12 

OATA  PR0GRM/6HCNTR  / 

CNTR 

13 

VINT=WINT/2  « 

CNTR 

14 

IG=3 

CNTR 

15 

JG=0 

CNTR 

16 

N03LE=i 

CNTR 

17 

NSTOR=NDAT  A 

CNTR 

18 

COMMENCE  SEARCH  LOOPS  FOR  IC  AND  JC 

CNTR 

19 

1 

DO  2  JC=1,JCX 

CNTR 

20 

DO  2  IC=1,ICX 

CNTR 

21 

CHECK 

IF  NSTOR  CAM  BE  FOLNC  IN  NET 

CNTR 

22 

IF(NET(IC,JC) .EQ.NSTCR)  GO  TO  9 

CNTR 

23 

c 

CONTINUE 

CNTR 

24 

COMMENCE  SEARCH  LOOP  FOR  NC 

CNTR 

25 

DO  3  NC=1,NCX 

CNTR 

26 

CHECK 

IF  NSTOR  CAN  BE  FOUNC  IN  NETSU 

CNTR 

27 

IF(NETSU(NC).EQ. NSTOR)  GO  TO  4 

CNTR 

26 

3 

CONTINUE 

CNTR 

29 

CALL  ERROR  ( PR OGRM,  -3  ,ISOUT) 

CNTR 

30 
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COMMENCE  TRACEBACK  THROUGI'  POINTER  SEUUENCE 

4  NG=NC-4» (NC/4) *1 
ING=+i 

JNG=-i 

CONVERT  NSTOR  TO  ITS  IMMEC IATELY  PRECEDING  POINTER 
NST  OR=-NC*3 
GO  TO  (8, 7, 6, 5),  NG 

5  ING=ING*2 
NSTOR=NSTOR+l 

6  JNG= JNG+2 
NSTOR=NSTOR*l 

7  ING=ING”2 
NST0R=NST0R-3 

COMPLTE  QUORANT  LABELS  IG  AND  JG 

8  IG=IG4-ING*  NOBLE 
JG= JG+JNG*ND3LE 
N0BLE=2*NDBLE 
VINT  =  VI NT/2  # 

CONTINUE  SEARCH  FOR  IC  ANC  JC 
GO  TO  1 

COMPUTE  XG  ANO  YG 

9  IG= IG+ND8LE 
JG=  JG4-N03LE 

XG=WINT*FLOAT(IC-l)  +VINT "FLOAT  ( IG)  4-XLLC 
YG=HINT*FLOAT(JC-ll "VINT "FLOAT <JGI *YLLC 
RETURN 
END 


CNTR  31 
CNTR  32 
CNTR  33 
CNTR  34 
CNTR  35 
CNTR  36 
CNTR  37 
CNTR  38 
CNTR  39 
CNTF  40 
CNTF  41 
CNTR  42 
CNTR  43 
CNTR  44 
CNTR  45 
CNTR  46 
CNTR  47 
CNTR  48 
CNTR  49 
CNTR  50 
CNTR  51 
CNTR  52 
CNTR  53 
CNTR  54 
CNTR  55 
CNTR  56 
CNTR  57 


"DECK, OATIN 

SUBROUTINE  OATIN (NET »NETSU «  Z3H , ZCH,T IHUP  *USUM» VSUM,RSUM, WFZ  , 
10XSUM,DYSUM,CAVS,MAfiY,ICF,JCF,NCF,MARF,KBHF,NDATF, LT IMF) 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978 

READS  ANO  PROCESSES  WINO  OATA.  READS  ANC  PROCESSES  TURBULENCE 
DATA,  OR  CALCULATES  TURBULENCE  OATA.  CALLS  SUBROUTINES  ONEDIN, 
TRIDIN  AND  WILKNS  FCR  ASSISTANCE. 

***********************  *«********'¥*¥*+«**'*#'*********#*******«#«»**»» 

COMMON  /CNTROL/  I  POUT  ,1  SI N , ISOUT , JP ARN , MC ( 2 0 ) , NSEQO 
COMMON  /INDEX/  I CX , JCX, K8HX , LTI MX, NA T, NCX, N D AT  X 
C 

INTEGER  WI NO*  TURB , M  E  1 EO R, RES OLV, SPEC, FORM, DONE, WILKS 
DIMENSION  NET  ( ICF  ,  JCF)  ,NETSU  (NCF  ) ,  NARY  ( MARF  >  ,ZBMK8HFI  ,ZCH(KBHF> 
DIMENSION  TIMUP(LTIMF) , USUM ( K8H F ,NQ A TF , LT IMF ) 

DIMENSION  VSUH (K8HF,N0A  TF,LTIMF) ,WFZ (KBHF,NDATF,LT IMF) 

DIMENSION  OXSDM(KBHF,NDATF,LTIMF),OYSUM(KBHF,NOATF ,LTIMF) 

DIMENSION  RSUM(K8HF,KDATF,LTIMF) 

C 

DATA  PROGRM  , A  LI  HIT  ,WIND  ,TUR3  ,D  ONE  , METE  OR ,RESOLV 
1  /6H0ATIN  , 999999.  ,4HH IN  0 , 4HTUR3 , 4HN0  M.4HMETE  ,4HR6S0/ 

OATA  INPU  ,  WILKS 

1  /4HINPU  .4HWILK  / 


OATIN  2 
OATIN  3 
DATIN  4 
OATIN  5 
OATIN  6 
OATIN  7 
OATIN  8 
DATIN  9 
DATIN  10 
DATIN  11 
DATIN  12 
OATIN  13 
DATIN  14 
OATIN  15 
DATIN  16 
DATIN  17 
DATIN  16 
DATIN  19 
OATIN  20 
OATIN  21 
OATIN  22 
DATIN  23 
DATIN  24 
DATIN  25 
OATIN  26 
DATIN  27 
OATIN  26 
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DATIN  29 
DATIN  30 
R  THAN  ,  DATIN  31 
DATIN  32 
*♦♦*/)  DATIN  33 
*  ♦  *  *  */) DATIN  3A 
TALLY  W  IT  H  DATIN  35 


I  FORHAT(A*»,  2X,  A4,  18X,  12,  FIO.J)  DATIN  30 

10  FORMAT! ///15X17HATHCSPHERE  UP0ATEI4,  22H  FCR  TIRES  LATER  THAN  ,  DATIN  31 

1  E12.5,  6H  SEC  (F8.3,  7H  HOURS)/)  DATIN  32 

II  FORMAT! 21X50H*  ********  WINDFIELU  OATA  ******♦♦*/>  DATIN  33 
12  FORMAT ( 21X  5 1H*  ********  TURBULENCE  OATA  ********  */)DATIN  3A 

21  FORMAT ( 1H0, 10X,  75HCOUNT  OF  UPDATA  DATA  SETS  CCES  NOT  TALLY  WITH  DATIN  35 

1SPECIFIEO  UPDATE  SECUENCE  NUMBERS)  DATIN  36 

22  FORMAT ( 1H0 ,  10X  ,  22H  A  DATA  SET  IS  MISSING)  DATIN  37 

23  FORMAT ( ///2CX,  59HIFQA  TE  INDEX  INCONSISTENT  WITH  UPDATE  TIME  ON  DATIN  38 

IAN  INPUT  CARD)  DATIN  39 

25  FORMAT!  1H0,  81HFIRST  UPOATE  WINDS  MUST  BE  INPUT  FIRST  WHEN  l-OI MEDATIN  40 
1NSIONAL  DATA  PROCESSING  IS  USED)  DATIN  41 

C  DATIN  42 

DO  50  L=l, LTIMF  DATIN  43 

YIMUPU  )=ALIMIT  DATIN  44 

PO  50  N=l, NOATF  DATIN  45 

USUM(1,N,L)=ALIMIT  DATIN  46 

50  DX5UM(1»N,  L)=ALIMIT  DATIN  47 

ZCH ( 1 ) =  ALI MIT  DATIN  48 

IF!MC(l).EQ.Q)GO  TO  500  DATIN  49 

CONSTRUCT  THE  HORIZONTAL  SPACE  RESOLUTION  NET  DATIN  50 

CALL  GETUPINET, NETSU, MARY, MARF ,ICF , JCF ,N CF , NOATF)  DATIN  51 

CONSTRUCT  THE  ATMOSPHERE  STRATA  DATIN  52 

CALL  LAYERS (ZCR,ZBH,KBHF)  DATIN  53 

GO  TO  1000  DATIN  54 

5C0  ICX=i  DATIN  55 

JCX=i  DATIN  56 

NDA TX=1  DATIN  57 

NET ( 1 , 1 ) =1  DATIN  58 

COPY  IN  DATA  SET  SPECIFICATIONS  DATIN  59 

1000  LTI MX=0  DATIN  60 

1002  REAO(ISIN,l)SPEC,FORM,LTIM,UPTIMH  DATIN  61 

IF(SPEC.EQ.OONEJGO  TC  3000  DATIN  62 

1003  IF!LTIM.LT.1.0R.LTIM.GT.LTIMF)CALL  ERROR  ( FROG RM 1 J C 3 , 1  SOU T)  DATIN  63 

UPT IMS=  UPT  IMH*  36C  0  •  DATIN  64 

1004  IF(TIMUP(LTIM)  .NE.  ALIM  IT ) IF { T I KUP ( LT I M ) -UP TI MS >5 0 0 3,  1 0  50 ,  500 3  DATIN  65 

TIMUP(LTIM)-UPTIMS  DATIN  66 

1050  IF'MC(2>  .NE.  1)  WRITEIISO'JT.IO)  L  TI  M,  UP  TIMS  ,U  PT  IMH  DATIN  67 

CHECK  IF  UPOATE  1  WINDS  ARE  INPUT  FIRST  WHEN  1-D  PROCESSING  IS  SPECI FI EDDA TI N  68 

1051  IF( LTIM  .GT.  1  .OR,  SPEC  ,£Q.  TUR5  .AND.  MC(1)  .EQ.  0)  DATIN  69 

1  IF(LTIMX- 1)1052, 1053, 1C 53  DATIN  70 

GO  TO  1053  OATIN  71 

1052  WRITE  <ISOUT ,25)  OATIN  72 

CALL  ERROR! PR0GRM.-1C52, ISOUT)  OATIN  73 

1053  IF (SPEC  «  EQ. TORS) GO  TO  2000  DATIN  74 

1055  IF(SPEC.NE.WIND)CALL  ERROR  C PROGRM , - 10 55 , I SOUT )  DATIN  75 

CONSTRUCT  WING  OATA  ARRAYS  DATIN  76 

IF1MCC2)  .NE.  1)  WRITE (ISOUT, 11)  OATIN  77 

LTIMX=LTIMX*1  DATIN  78 

1060  IF(LTIMX.GT.LTIMF)CALL  ERROR ( PRQGRM, -1 „ 60 , I SCU T )  DATIN  75 

IF  ( MC  (1 )  . NE.  0)  GO  10  1100  DATIN  30 

CONSTRUCT  WIND  OATA  ARRAYS  VIA  THE  SIMPLIFIED  1-DIMENSIONAL  METHOD  OATIN  81 

CALL  ONEDIN(ZCH,ZBH,CAVS,USUM  ,VSUM  , LTI M, K8HF, NOATF, LTIMF ,  DATIN  6< 

1  FORM , S PEC )  U AT  IN  83 

OO  1070  N=l,NOATX  DATIN  84 

no  1370  K=1 , KBHX  DATIN  65 

U'7Q  WFZ  (K.N,  LTIM)=U.O  OATIN  36 

GO  TO  1200  DATIN  87 

CONSTRUCT  THE  WIND  DATA  ARRAYS  VIA  THE  3-DIMENSICN AL  METHOD  DATIN  8e 


NOT  TALLY  WITH  DATIN  35 
OATIN  36 
DATIN  37 
UPDATE  TIME  ON  OATIN  38 
DATIN  39 


DATIN  43 
DATIN  44 
DATIN  45 
DATIN  46 
DATIN  47 
DATIN  48 
DATIN  49 
DATIN  50 
DATIN  51 
DATIN  52 
DATIN  53 
OATIN  54 
DATIN  55 
DATIN  56 
DATIN  57 
DATIN  58 
OATIN  59 
DATIN  60 
DATIN  61 
DATIN  62 
>OUT)  OATIN  63 

OATIN  64 
SO,  5003  OATIN  65 
OATIN  66 
OATIN  67 
SPECI FI EDDA  TIN  68 
DATIN  69 
OATIN  70 
OATIN  71 
OATIN  72 
DATIN  73 
DATIN  74 
DATIN  75 
DATIN  76 
OATIN  77 
DATIN  78 
DATIN  79 
DATIN  80 
rHOD  OATIN  31 

rF, LTIMF,  DATIN  82 
U AT  IN  83 
DATIN  84 
DATIN  65 
OATIN  36 
DATIN  87 
DATIN  88 
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1108  CALL  TRIOIN  (NE  1  »NETSU  ,ZCH,USUM  ,V SUM  , WF Z , LT I M ; ICF, JC F, NGF , 

1KBHF,  NOATF.LT  IMF,  FORM, SPEC) 

COMPUTE  WlNO  DIRECTION  ANGLE  ARRAYS 
1200  CONTINUE 

00  1300  NsltNOATX 
00  1300  K=1 »  KBHX 

IF(A9S{USUM(K,N,LTIM)).GE.1.0E-30)GO  TO  1254 
IF ( A3S( VSUM(K»  N*LTIM) ) .GE.  1.  0E-3Q)  GO  TO  1253 
RSUN<K.N,LTIM)=0.0 
GO  TO  1300 

1253  P.SUM(K,N, LTIM) =SIGN ( 1. 57 C79 6 33 , VSJM ( K , N, LT IM ) ) 

GO  TO  1300 

1254  RSUM(K,N,LTIM)=ATAN (VSUM(K, N, LTIM) /USUMCK.h, LTIM) ) 
IF(USUM(K,N,LTIM)  .LT.  0.0)  RSUM(K,N .LTIM)  =  RSLM ( K ,N , LTIM )  - 

1  SIGN!  3. 1 41592654, RSUM (K.N.LTIM)) 

1300  CONTINUE 

GO  TO  1002 

CONSTRUCT  THE  TURBULENCE  CATA  ARRAYS 

2000  IF  1 MC (2 )  .NE.  1)  WRITE( IS0UT.12) 

IF (FORM  ,EQ.  INPU)  GC  TO  21U0 

2001  IF( FORM  .NE.  WILKS  )  CA LL  ERROR (PROGRM , -2 J 0 1,1 SOUT > 

CALCULATE  TURBULENCE  DATA  BY  WILKINS*  FUNCTION  OF  RECIPROCAL  ALTITUDE. 

C  TURBULENCE  WILL  BE  HORIZONTALLY  UNIFORM. 

CALL  WILKNS  ( ZCH, OXSUM , OY SUM ,C AVS  »  TIMUP, KBHF.NDATF.LTIMF, 

1  LTIM) 

GO  TO  1002 
2100  FORM=RE SOLV 

IF (HC (1 )  .NE.  0)  GO  TO  2200 

CONSTRUCT  THE  TURBULENCE  CATA  ARRAYS  VIA  THE  SIMPLIFIED  1-DIMENSIONAL 
C  METHOO 

CALL  ONEOI N ( ZCH, Z8H, C A VS, DXSUM.DY SUM, LTIM, KBHF.NDATF.LTIMF, 

1  FORM, SPEC) 

GO  TO  1002 

CONSTRUCT  THE  TURBULENCE  CATA  ARRAYS  VIA  THE  3 -DI MFN S I CNAL  METHOC 
220  0  CALL  TRIOINCNE  I.NETSU , ZCH  ,OXSUM  ,0  YSUM.CtU M  v LT IM  ,  ICF , J CF , NCF , 

1KBHF,N0ATF,LTIMF,FCRM,SP£C) 

GO  TO  1 Qu2 
3C00  CONTINUE 
CHECK  DATA  FOR  ERRORS 
LTIM=0 

OO  3100  L=1 ,LTIMF 
IF(TIMUP(L) .EQ.ALIMIT)G0  TO  31UQ 
LTIM=LTIM+1 
3100  CONTINUE 

IF(LTIM.EQ,LTIMX)GO  TO  32LC 
WRITE (IS OUT, 21) 

3105  CALL  ERROR  (PROGRM ,- 310 5 ,1 SOUT ) 

3200  OO  3250  L^l.LTIMX 
DO  3250  N= 1, ND  AT  X 

IF(USUM(1,N,L) .EC.ALlMIT.OR.OXSUM(l,N,u).£Q.ALIMIT)GO  TO  3275 
3250  CONTINUE 
P.ETURN 

3275  WRITE  (I30UT.22) 

3276  CALL  ERR0R(PRQGRM,-3Z76,IS0UT) 

5003  WRITE (ISOUT,23) 

CALL  ERROR( PROGR M ,  -1004,  ISOUT) 

END 


DATIN  39 

DATIN  90 

DATIN  91 

DATIN  92 

DATIN  93 

DATIN  94 

DATIN  95 

DATIN  96 

DATIN  97 

DATIN  96 

OATIN  99 

DATIN100 

OATIN1C 1 

DATIN1J2 

DA  TIN  103 

DATIN134 

DATIN1J5 

O A  TI Nlu  6 

DATIN1J7 

DATIN138 

DATIN1J9 

DATIN11C 

DATIN 111 

DATIN112 

0ATIN113 

DATIN114 

DATIN115 

DA  TI N 1 16 

DATIN 117 

DATIN118 

0ATIN119 

DATIN120 

DATIN121 

DATIN122 

DATIN123 

0ATIN124 

0ATIN125 

DATIN126 

DATIN127 

DA2I N128 

9ATIN129 

DATIN130 

0ATIN131 

DATIN132 

D A  TI N133 

DATIN134 

0ATIN135 

0ATIN136 

DATI N1?T 

DATIN136 

DATIN 139 

DATINX40 

0ATIN141 

DATIN142 

DATIN143 

DATIN144 

DATIN145 
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♦DEC  K,  DTMEX  DTMEX 

SUBROUTINE  DTMEX (NUMTAP)  DIHEX 

DTMEX 

H.  G.  NORMENT,  ATMOSPHERIC  f.CIENCE  ASSOCIATES  -  DECEMBER  1976  DTMEX 

DTMEX 

**  **********  ************  4i  *******«*******««*******+**«****************  **D  TME  X 

DTMEX 

OIFFUSIVE  TRANSPORT  HOGUE  OTMEX 

DTMEX 

ARRAY  0 IME  MSI  0  NS  MIST  BE  SET  IN  THIS  PROGRAM.  THESE  ARE  MAXIMUM  DTMEX 
DIMENSIONS  TO  8E  USED  IN  THIS  RUN.  DIMENSION  MNEMONICS  AND  THE  OTMEX 

DATA  FIELO  LENGTHS  THEY  CONTROL  ARE  AS  FOLLOWS  -  DTMEX 

ICF, JCF-  PRIMARY  HCRIZOFTAL  SPACE  RESOLUTION  NET  INDICES  DTMEX 

(ARRAY  NET)  DTMEX 

ICF  IS  THE  NUMBER  OF  EAST-WEST  NET  SUBDIVISIONS  DTMEX 

JCF  IS  THE  NUMBER  OF  NORTH-SOUTH  NET  SUBDIVISIONS  DTMEX 

KBHF  -  ATMOSPHERE  STRATA  FOR  WIND  AND  TURBULENCE  OATA  DTMEX 

( ARRAYS  USUM,VSUM,WFZ,OXSUMJOYSUM,RSUH,TSUM,ZBH»ZCH,  DTMEX 

CA.VS.WAVG)  OTMEX 

LTIMF  -  WIND  AND  TIRBULENCE  DATA  UPOATES (INCLUDING  INITIAL  DATA) DTMEX 

(ARRAYS  USUM, VSUM, WFZ ,QXSUM, DYSUM,RSUM,WAVG,HDAV)  DTMEX 

MARF  -  DIMENSION  CF  THE  ARRAY  (MARY)  THAT  RE'CIEVES  THE  FLAGS  DTMEX 

WHICH  DEFINE  THE  HORIZONTAL  SPACE  RESOLUTION  NET  DTMEX 

NATF  -  ATMOSPHERE  STRATA  FOR,  PRES,  TEMP,  r *C.  (ALWAYS  256)  DTMEX 

NOATF  -  HORIZONTAL  SFACE  RESOLUTION  NET  An.  jLB-NET  MESHES  DTMEX 

(ARRAYS  LSUM, V  SUM  *WFZ  *DXSUM, D  YSUM, RS  UM )  DTMEX 

NCF  -  HORIZINTAL  SFACE  RESOLUTION  NET  MF.SH  SUBDIVISIONS  DTMEX 

(ARRAY  NETSU)  DTMEX 

DTMEX 

****************»*,  *********  GLOSSARY  ****************************  OTMEX 

DTMEX 

ALT  -  ALTITUDES  FOR  ATMOS.  OENSITY  AND  VISCOSITY  TABLE  OTMEX 

CAVS  -  PARTICLE  FALL  RATE  FOR  EACH  ATMOS.  STRATUM  OTMEX 

CROSS  -  CROSSWINO  CROSSING  TRAJECTORIES  CORRECTION  TO  DISPERSION  OTMEX 
DOWN  -  OOWNWINO  CROSSING  TRAJECTORIES  CORRECTION  TO  DISPERSION  OTMEX 
OWAF  -  PARCEL  VERT.  THICKNESS  BEFORE  AOVECTION  DTMEX 

OXSUM  -  TURBULENCE  X  COMPONENT  (WEIGHTED  SUM)  3-CIM.  DATA  ARRAY  DTMEX 

OYSUM  -  TURBULENCE  Y  COMPONENT  (WEIGHTED  SUM)  3-DIM.  DATA  ARRAY  OTMEX 

EDO Y  -  RATIO  OF  L AGRANG IAN  TO  EULER IA  N  TIME  SCALES.  SET  TO  4,0  DTMEX 
BY  PGM.  IF  INPUT  AS  ZERO.  DTMEX 

ETA  -  DYNAMIC  VISCOSITY  OF  AIR  OTMEX 

FAV  -  PARTICLE  SETTLING  RATE  AT  MID  ATMOSPHERE  ALTITUDE  DTMEX 

HDA V  -  AVERAGE  HORIZONTAL  0IFFU3IVI TY  OR  TURBULENCE  DISSIPATION  DTMEX 
RATE  FOR  EACH  ATMOSPHERE  UPDATE.  DTMEX 

ICF  -  MAX.  FORMAL  CIM.  CORRESPONDING  TO  ICX  DTMEX 

ICX  -  OBJECT-TIME  MAX.  NUMBER  CF  WEST-EASI  MESHES  IN  ARRAY  NET  DTMEX 

IPOUT  -  LOGICAL  UNIT  NUMBER  OF  DIFF.  TRANS.  MOO.  OUTPUT  TAPE  DTMEX 

ISIN  -  LOGICAL  UNIT  NUMBER  OF  SYSTEM  INFUT  TAPE  DTMEX 

ISOUT  -  LOGICAL  UNIT  NUMBER  OF  SYSTEM  OUTPUT  TAPE  DTMEX 

JPARN  -  LOGICAL  UNIT  NUMBER  OF  ICRM  OUTPUT  TAPE  DTMEX 

JCF  -  MAX.  FORMAL  CIM.  CORRESPONDING  TC  JCX  DTMEX 

JCX  -  08JECT-TIME  FAX .  NUMBER  OF  SOUTH-NORTH  MESHES  IN  ARRAY  NET  DTMEX 

KBHF  -  MAX.  FORMAL  (IM.  CORRESPONDING  TO  KBHX  OTMEX 

KBHX  -  OBJECT-TIME  MAX,  ATMOSPHERE  LAYER  INDEX  FOR  WIND  AND  TURB. DTMEX 

LTIMF  -  MAX,  FORMAL  CIM.  CORRESPONDING  TO  LTIMX  DTMEX 

LTI MX  -  OBJECT-TIME  MAX •  INDEX  FOR  WIND  AND  TURB.  UPDATES  DTMEX 

(INCLUDES  THE  INITIAL  SET)  OTMEX 

MARF  -  MAX.  FORMAL  CIM.  CORRESPONDING  TC  MARX  OTMEX 

MARX  -  OBJECT-TIME  MAX.  DIM.  OF  ARRAY  MARY  (M AKX= ICX* JCX)  DTMEX 

MARY  -  HORIZ.  ATMOS.  SPACE  RESOLUTION  NET  MESH  AND  SUB-MESH  OTMEX 
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ooooooooooooooooooooooonooooooonoooooooooooooooooooooooooo 


MC 

NAT 

NATF  - 
NBLK  - 
NCF 
NCX 

NDATF  - 
NDATX  - 

NET 

NETSU  - 
NSEQO  - 
N1 , N2  »  - 

RADG  - 
RHO 
RLH 
RO 

RHOP  - 
RSUM  - 
RWAF  - 
SIGH  - 
SIGXO  - 
SIGYO  - 
TIME  - 
TIMEX  - 
TIMUP  - 
TMA  X  - 
TO 
TP 

USUM  - 
VARL  - 

VSUM  - 
WAVS  - 
WAVGK  - 
WFZ 

WINT  - 

XLLC  - 

XO 

XP 

YLLC  - 

YO 

YP 

7BH 

7CH 

ZLOW  - 
ZM  A  X  - 
7  MIN  - 

zo 

ZP 

7UPP  - 

**«»***««*« 

COMMON 

DIMENSI 


TC  RACI ANS=PI/180 


AFTER  A  OVECTION 


(WEIGNTED  SUM)  3-UIH. 


CONTROL  FLAGS  OATA  ARRAY 
C'VTR'H  INTEGER  OATA  ARRAY 

NUMBER  OF  ALTITUDE  STRATA  IN  ATMOS.  T.P.RHO,  ETC.  TABLE 
MAX.  FORMAL  DIM.  CORRESPONDING  TC  NAT  (SEE  ABOVE) 

RECORD  eLOCK  SIZE  FOR  FALLOUT  PARCEL  OATA  ARRAYS 
MAX.  FORMAL  CIM.  CORRESPONDING  TC  NCX 
OBJECT-TIME  MAX.  DIM.  OF  ARRAY  NETSU 
4* ( NUMBER  CF  ZEROS  PUNCHEO  IN  MARY  INPUT  CARDS) 

MAX',  FORMAL  DIM.  CORRESPONDING  TC  NDATX 
NUMBER  OF  ONES  (1)  PUNCHEO  IN  MARY  INPUT  CAROS  (I.E., 
TOTAL  NUMBER  OF  HORIZONTAL  SPACE  RESOLUTION  MESHES) 
PRIMARY  HORIZONTAL  SPACE  RESOLUTION  MESH  ARRAY 
HORIZONTAL  SPACE  RESOLUTION  SUB-MESH  ARRAY 
STORAGE  SEQUENCE  INDEX  OF  FIRST  PARCEL  TO  BE 
INPUT  DATA  POINTERS 
CONVERSION  FACTOR  FROM  OEGREES 
ATMOS.  DENSITY 
RELATIVE  HUMIDITY 
WIND  HEADING  ORIENTATION  ANGLE 
FALLOUT  PARTICLE  DENSITY 
WIND  HEADING  ORIENTATION  ANGLE 
PARCEL  RADIUS  IN  PARCEL  CENTRAL  PLANE  BEFORE.  ADVECTICN 
STANOARO  OEVIATION  OF  VERTICAL  TURBULENCE  (M/SEC) 

PARCEL  DOWNWIND  OISPERSION  PARAMETER 

PARCEL  CROSSINO  OISPERSION  PARAMETER 

TIME  AT  ONSET  OF  CURRENT  PARCEL  TIME  INTERVAL 

OVERALL  TRANSPORT  TIME  LIMIT 

ATMOSPHERE  LFOATE  TIMETABLE  OATA  ARRAY 

TRANSPORT  TIME  LIMIT  FOR  A  PARTICLE  SIZE  CLASS 

TIME  AFTER  PARCEL  AOVECTIQN 

TIME  BEFORE  PARCEL  AOVECTION 

WIND  X  COMPONENT  (WEIGHTEO  SUM)  3-DIM.  OATA  ARRAY 
OISPERSION  VARIANCE  OF  A  PUFF  ABOVE  WHICH  THE  DISPERSION 
RATE  BECOMES  CONSTANT 

WINO  Y  COMPONENT  (WEIGHTEO  SUM)  3-DIM.  CATA  ARRAY 
AVG.  ATMOS.  VERT.  WINO  PER  UPDATE  f’ER  STRATUM 
OVERALL  AVERAGE  VERTICAL  WINO  COMPONENT 
WINO  l  COMFCNENT  3-GIM.  DATA  ARRAY 

MESH  INCREMENT  OF  THE  PRIMARY  HORIZONTAL  SPACE  RESOLUTION 
NET 

CORNER  CF  ATMOS. 

AFTER  AOVECTION 
dEFORFi  ADVECTION 
CORNER  OF  ATMOS. 

AFTER  ACVfcC  TICN 
BEFORE  AOVECTION 


DTMEX 

DTKEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 

DTMEX 


X  COORDINATE  OF 
PARCEL  CENTER  X 
PARCEL  CENTER  X 
X  COORDINATE  OF 
PARCEL  CENTER  Y 
PARCEL  CENTER  Y 


SPACE 


SOUTH-WEST 
COORDINATE 
COORDINATE 
SOUTH-WEST 
COORDINATE 
COORDINATE 

ATMOSPHERE  STRATA  BASE-ALTITUDE  DATA  ARRAY 
ATMOSPHERE  STRATA  MIO-ALTITUDE  OATA  ARRAY 
PARCEL  BASE  ALTITUDE  BEFORE  AOVECTION 
ATMOSPHERE  TCP  ALTITUDE  RELATIVE  TC  MEAN  SEA 
DEPOSITION  PLANE  ALTITUDE  RELATIVE  TO  MEAN  SEA 
PARCEL  CENTER  Z  COORDINATE  AFTER  ADVECTICN 
PARCEL  CENTER  Z  COORDINATE  BEFORE  AOVECTION, 
REDEFINED  IN  SUB.  AOVEC 

PARCEL  TOP  ALTITUDE  BEFORE  ADVECTICN.  ZLCW+DWAF 


TKANSFORT  ED DTMEX 
DTMEX 
DTMEX 
DTHEX 
DTMEX 
DTMEX 
OTMEX 
ARRAYDTMEX 
OTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMEX 
OTMEX 
DTMEX 
OTMEX 
DTMEX 
DTMEX 
DTMEX 
DTMtXluO 
DT  ME  X 10  1 
DTMEX 102 
DTMEX1J3 
D  T  M£X10  4 
DTMEX105 
0TMEX1Q6 
DTMEX1G? 
DTMEX1J3 
DTMEX1J9 
LEVEL  DTMEX110 

LEVEL  OTMEXlil 

DT  MEX 112 
ECXEPT  AS  0TMEX113 

DTMEX114 
DTMEX115 
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62 

63 

64 

65 

66 
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69 

70 
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74 

75 
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77 
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79 
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85 

86 
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92 

93 

94 
55 

96 

97 

98 

99 


SPACE 


DTMEX116 

.i,*  .*♦**■*♦  .**♦♦**  *ofMEXll  7 

DTMEX118 

/CNTRCL/  IPOUT.ISIN, I  SO UT , J PA RN , MC ( 2 0 ) , NSEQO  DTMEX119 

ON  NUMT A P ( 1 5 )  DTMEX120 

112 


1  .CltEIrl  fin?  MIS',  ,-'3~!-VK?.trjt?r  Sirtm+r-*-. 


DIMENSION 

ALT (236), 

ATP  (256) 

, PRS (256) , RLH (256 ) 

, RH  C( 25  fc) , E  T  A ( 256) 

DTMEX121 

DIMENSION 

NET  ( 

1,  1)  ,N£TS'J(  1)  ,  WAV  G  (  35, 

6) 

DTMEX122 

DIMENSION 

USUM  ( 

35, 

it 

6),  VSUM  ( 

35, 

1, 

6) 

DTMEX123 

DIMENSION 

DXSUM ( 

35, 

it 

6) , DYSUM ( 

35, 

1. 

6) 

DTMEX124 

DIMENSION 

RSUM  ( 

35, 

it 

6) , CA VS ( 

35)  , HDA V  ( 

6) 

DTMEX125 

DIMENSION 

ZBH  (  35) 

,  ZCH  ( 

35)  , 

TI MUP  (  6), 

M  ARY(  1) 

DTMEX126 

OIMcNSI ON 

WFZ  ( 

35, 

it 

6),  TSUM( 

3  5) 

DTMEX127 

DATA  ICF  ,  JCF 

,  MA  PF 

,  NCF 

, NOATF  ,K6HF  , LTIMF 

OTMEX126 

/ 

i  ,  1 

.  1 

•  1 

»  It 

35  ,  6 

/ 

OTMEX129 

NATF=256  DTMEX1.30 

ISIN  =NUMTAP(  i)  0TMEX131 

ISOUT=NUMTAP<  21  0TMCX132 

IPOUT=NUMTAP(  3)  0TMEX1 33 

JPARN=NUMTAP(  41  0TMEX134 

DO  1  N= i »NCF  DTMEX135 

1  NETSU  < N I =  0  DTMEX136 

00  2  J=i,JCF  DTMEX137 

DO  2  1=1, ICF  DTMEX138 

2  NET  <I,J)=0  DTMEX139 

DO  3  M= If  HARF  OTMEX140 

3  MA RY ( M) =0  DTMEX141 

DO  4  K=1»KBHF  DTMEX142 

CAVS(K)=0.  DTHEX143 

TSUM(  Kl  =ll«  0TMEX144 

ZBH(K)  =  0.  DTMEXX45 

4  ZCH (X )  =  0  «  DT  ME XI 46 

DO  5  L=  i, LTIMF  DTMEX1*.  7 

HOAV(L)=J.  DTMEX148 

TIMUP(L)=0.  DTMEX149 

DO  5  K= 1, KBHF  DTMEX150 

5  WAVG(K,L)=O.Q  DTMEXi5i 

DO  6  L=if LTIMF  DTMEX1E2 

DO  6  N= 1, NOATF  DTMEX1 53 

DO  6  K= 1 f K8HF  0TMEX154 

WFZ(K,N,L)=C.  DTMEX155 

USUM  ( K, N,L) =0  •  DTMEX156 

VSUM (K,N,L)=0»  DTMEX157 

DXSUM  (X ,  N,  L  )=0  •  DTMEX158 

DYSUM (K,N»L)=D.  DTMEX159 

6  RSUM  ( Kt  N,L ) =0 •  DTMEX16C 

COMMENCE  READING  DATA  INPUTS  FROM  TAPES  ISIN  AND  JPARN  DTMEX161 

CALL  DTHINT  ( ALT , A  TP , PRS , RLH, RHO,  t T A , N ATF  )  DTMEX162 

CONTSRUCT  AND  FILL  IN  THE  ATMOSPHERIC  LATTICE  AND  UPOATE  STRUCTURE  DTMEX163 

COPY  IN  AND  PROCESS  WINO  AND  TURBULENCE  DATA  DTMEX164 

CALL  OATINCNET.NETSU  ,Z8H, ZCH, T IMUP, USUM, VSUM, RSUM, WFZ ,  DTMEX165 

10X3UM.0 VSUM,CAVS , MA RY , ICF , JCF , NCF , MA RF , KBHF , NO  A TF, LTIMF)  0TMEX166 

COMPUTE  WEIGHTED  SUMS  OF  WIND  AND  TURBULENCE  DATA  DTMEX167 

CALL  SUMOATT NET, NETSU  ,ZBH , ZCH, WAV G.HOAV, USUM, VSUM, RSUM  ,WFZ ,  QTMEX166 

1 TIMUP, D XSUM, DYSUM, ICF, JCF, NCF, KBHF, NOATF, LTIMF >  DTMEX169 

CALCULATE  THE  DIFFUSIVE  TRANSPORT  OF  PARCELS  ACCEPTED  FROM  TAPE  JPARN  DTMEX170 
COPY  OUT  RESULTS  ONTO  TAPE  IPOUT  DTMEX171 

CALL  SPRVS(NET»NETSU,Z8Ht ZCH, TIMUP, USUM, VS  CM, DXSUM , JYSUM,  DTMEX172 

1RSUM, WFZ,CAVS,HOAV,TSUM, WA VG , ALT , A  TP ,PRS , RL H ,R HO ,ET A ,  DTMEX17  3 

2 ICF, JCF, NCF, KBHF, NOATF, LTIMF, NATF)  DTMEX174 

RETURN  DTMEX175 

ENO  DTMEX176 
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*0ECK,0TMINT  OTMIN 

SUBROUTINE  OTHINT ( ALT , ATP ,PRS , RLH ,RH 0, ETA , N ATF )  DTMIN 

OT  HI  N 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  197  8  DTMIN 

DTMIN 

¥■  +  ¥■  #*«*¥*  #>►**.  **  *  ***  ¥#**  ♦***«  if  *  **  +  <■■*  4*  «  *«**  *•»**  *  ***  *  *  ***♦**♦»  QJ 

OTMIN 

DIFFUSIVE  TRANSPORT  MODULE  INITIALIZATION*  READS  CAPO  INPUTS.  OTMIN 

READS  BASIC  DATA  ON  THE  BINARY  TAPE  WRITTEN  BY  SUBROUTINE  WNOSFT  DTMIN 
OF  THE  INITIALIZATION  ANC  CLOUD  RISE  MODULE.  PRINTS  HEADER  AND  OTMIN 
BASIC  DATA  AND  INITIALIZES  THE  GTM  DINAR!  OUTPUT  TAPE.  DTMIN 

DTMIN 

DTMIN 

COMMON  /CNTROL/  IPOUT, ISIN, ZSOUT , JPARN »MC ( 20 > , NSEQO  DTMIN 

COMMON  /INDEX/  ICX , JCX , K8HX , LTI MX, NA T» NCX, NDAT X  DTMIN 

COMMON  /PARCL/  CR0S5»00WN, OWAF . EOOY , NUATP ,PMA $, PS JZ , RHOP ,RWAF ,  DTMIN 

1  TP,XP, YP,ZLOW,ZP  DTMIN 

COMMON  /SPACE/  WINT,XLLC*YLLC»ZMAX*ZNIN, TIMEX  DTMIN 


FORMATT 12A61 
FORMATf  1QX, 


■OUT,  ISIN, ISOUT , JPARN ,HC { 20 > * NSEQO  DTMIN 

!, JCX, K8HX, LTI MX, NAT, NCX, NDAT X  DTMIN 

tQSS, DOWN, OWAF, EOOY, NUATP,PMA$, PS JZ , RHOP  ,  RWAF ,  DTMIN 

DTMIN 

<T,XLLC,YLLC, ZMAX,ZNIN, TIMEX  DTMIN 

OTMIN 

DIMENSION  ALT (NA  TFT  ,  ATP (NATF  > ,PPS(NATF>  ,RL H  INA TF > , RHC (NATF )  OTMIN 

DIMENSION  ETA(NATF),PS (200 )  ,OIAM  120G ) , F MASS (20 0 >  DTMIN 

DIMENSION  OETID<12>  ,  CTMIDU2)  DTMIN 

OTMIN 

DATA  PR0GRM/6H0TMI NT /  DTMIN 

DTmIN 
DTMIN 

INITIALIZATION  AND  CLOLD  RISE  MODULE  IOENTTFICATDTMIN 
4  A  PO  IFFUSX  VE  TRANSPORT  MODULE  IDENTIFICATION  -  , DTMIN 

DTMIN 

COPTROL  VARIABLE  ARRAY,  MC(J)»  HAS  BEEN  GIVEN  THDTMIN 

DTMIN 


S4H INITIALIZATION  AND  CLOLD  RISE 
X,  44PUIFFUSXVE  TRANSPORT  MODULE 


1 ION  -  , 12A 6/  20X,  44PUIFFUSXVE  TRANSPORT  MODULE  IDENTIFICATION  -  , DTMIN 
2  12 A6)  DTMIN 

7  F0RMAT</15X6?HTHE  CGMROL  VARIABLE  ARRAY,  MC(J)»  HAS  BEEN  GIVEN  THDTMIN 

IE  VALUES  -)  DTMIN 

8  FORM AT( 15X  , 20 14)  DTMIN 

9  KORHAT(/28X28HTNE  TRANSPORT  TIME  LIMIT  IS  F12, 3,  7H  SEC.  (FlO.5,  DTMIN 

1  7H  HOURS) )  DTMIN 

10  FORMAT  <  15X,  39HA  PLANE  DEPOSITION  SURFACE  AT  ALTITUDE  F9.3,  30  H  DTMIN 

1  (METERS  ABOVE  MSU  IS  ASSUMED)  DTMIN 

14  FORMAT ( 15X , 46H COORD I NATES  OF  GROUND  ZERO  (XGZ, YGZ, ZGZ)  ARE  (E12. 5, DTMIN 

1  2H »  E12.5, 2H,  E12.5*10Hi  ( METEKS)  /  42X1 6I-0ETQN  ATIQN  TIME  ISE.12,5,  DTMIN 

2  8H  SECONDS/)  OTMIN 

21  FORMAT (2  014 )  DTMIN 

23  FORMAT (  1H1,///51X,  19H*  *  *  *  *  *  *  *  *  *//55X,liNQ  E  L  F  I  C//  DTMIN 

1  12 X,  101HT  H  C-  D  E  P  DTMIN 

2A  R  T  M  E  N  T  OF  DEFENSE  FALLOUT  P  R  E  D  I  C  DTMIN 
3TION  SYSTE  P//51X19H*  ********  * ////48X , 26HOIFFU SI OTMIN 

4  VE  TRANSPORT  MOOULE///  55X,  UNPREPARED  BY/  ‘♦&X,  3  OHO  T  MI  N 

5  ATMOSPHERIC  SCIENCE  ASSOCIATES/  54X*  14H3EDF0RC,  MASS.  DTMIN 

6////  41 X,  40H*****  SUMMARY  Of  RUN  IDENTIFIERS  *****)  DTMIN 

27  FORMA T( 15X ,  76HH0RIZCN TAL  COORDINATES  OF  THE  SOUTH  WEST  CORNER  OF  OTMIN 
1  THE  TRANSPORT  SPACE  ARE  (E12.5,  2H,  E12.S,1M)/  35X,  JOHYHE  R.ESOLUTDT  MI  N 


2  ION  NET  SPACING  IS  E12.5,  16H  t ALL  IN  METERS)) 

40  FORMAT ( 8F10 • 0 ) 

43  FORMAT(/15X,28HFALLCUT  PARTICLE  DENSITY  IS  El2»5,8H  KG/M**  3 , 
1  12H  THERE  AREI5 ,  22H  PARTICLE  SIZE  CLASSES) 

45  FORMAT</  15X,  36HPAHTICLE  PROCESSING  BEGINS  WITH  THE  16,  12H 
1RTICLE) 

46  FORMAT  < 1H1) 

47  FORMAK/  15X,  28 HTRANS  FORT  IS  BY  THE  ) 

48  FORMAT ( IHh  34X,  12HQUICK  METHOD) 

49  FORMATdH*,  34X,  21  PLAYER-BY-LAYER  METHOD) 

1 14 


DTMIN 
DTMIN 
*3,  OTMIN 

DTMIN 
12H  TH  PACT  MIN 
DTMIN 
OTMIN 
Of  MIN 
DTMIN 
DTMIN 
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50  rORMAT(  26  X,  57HRATI C 
1ES  ISF8.3) 


LAGRANGIAN  TO  EULERIAK  TURBULENCE  TIME  SCAL 


TRANSPORT 


COPY  IN  IDENTIFICATION  FOR  DIFFUSIVE  TRANSPORT 
READ  ( I  SIN  , 1)  DThID 

COPY  IN  OPTION  CONTROL  COOE  DATA  FOR  DIFFUSIVE  TRANSPORT 
READ  (I  SIN, 21) MC 
READ  <  IS  IN*  21)  ICX..JCX, NSEQO 
IF(ICX  .  EQ.  L )  ICX=i 
IF ( JCX  .ECU  t)  JCX=1 
IF ( NSEQO  ,EQ.  0)NSEQG=1 
READ  (IS  IN,  40)  HINT,  XL  LC»YLLC«T  l'MEH,  EDDY 
IF ( EDDY  . EQ  .  0.0)  EC0Y=4.Q 
COMPOSE  ALL  TAPES  NEEOEO  FOR  (DIFFUSIVE  TRANSPORT 
REWIND  JPARN 
REWIND  I POUT 

COPY  IN  BASIC  HEADER  OATA  FROM  ICRM  OUTPUT  TAPE 

REAO  ( JPARN) FW,SSAM, SLOTMP.TMSD, SO, W, HEIGHT, KM  OF, RADMAX.ZMIN 

READ  <JPARN)XGZ,YGZ,TGZ 

REAO  (JPARNMOETIO(I), 1=1,12) 

READ  (JPARN)NDSTR 

READ  (JPARN)  (PS(J)  ,  C 1AM  ( J)  ,  FMASS  ( J )  ,  J=1  ,  N1DSTR) 

READ  (JPARN)NAT 

READ  (JPARN) (ALT ( J) , ATP ( J) , PRS ( J) , RLH( J ) , RHO ( J ) , ET A ( J) , J=1 , N AT ) 
COPY  OUT  HEAOER  OATA  ON  TO  THE  OTM  BINARY  OUTPUT  TAPE 

WRI TE  (I  POUT)  FW  ,  SSAH  »SLOTMP  ,TMSD,SO»WtHEIGHT»RHOP,RADMAX,2.MIN 

WRITE  II  POUT.)  XGZ,  YGZ*TGZ 

WRITE  (IPOUT)  (DETIO(J),  J=l,12) 

WRITE  (IPOUT)  (DTMIC  (J) , J=i,12) 

WRITE  ( IPOUT)  NOSTR 

WRITE  (IPOUT)  <PS(J)  ,OIAM  ( J  )  ,'f,1AS5(J>  ,J=1,  NOSTR) 

COPY  OUT  DIFFUSIVE  TRANSPORT  HEADING 
WRITE  ( ISOUT, 23) 

WRITE  (ISOUT, 2)  (OETID (J ) , J=l, 12) , (OTMIO (J) , J= 1, 12) 

WRITE  (ISOUT, 7) 

WRITE  (ISOUT, 8)MC 
TIMEX=TIMEH*3600. 

WRITE  (ISOUT, 9)  TIMEX,  TIMEH 

IF (MC (6 )  ,GT.  0)  WRITE(IS0UT»5Q)  EOOY 

WRITE(IS0UT,14)XGZ,Y(Z,ZMIN,TGZ 

WRITE (ISOUT, 27) XL LC , YLLC , WI NT 

WRITE  (IS  OUT,iO)ZMIN 

WRITE (I  SOU T, 43 )RHOP, NOSTR 

WRITE(IS0UT,47) 

IF ( MC (4 )  .EQ.  0)  WRITE<IS0UT,48) 

IF (MC (4 )  .NE.  C)  WRITE(IS0UT,49) 

IF  (  NSEQO  *  NE.  1)  HR  I  TE(  ISOU  T ,  45)  NSEQO 
IF ( MC (2 )  .NE.  1)  WRITE (IS OUT, 46) 

RETURN 

ENO 


NSEQO 
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OTHIN  62 
OTMIN  63 
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OTMIN  65 
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DTMIN  85 
T  MIN  86 
L  MIN  87 
DTMIN  38 
DTMIN  89 
DTMIN  90 
OTMIN  91 
OTMIN  92 
DTMIN  93 
DTMIN  94 
DTMIN  95 
DTMIN  96 
DTMIN  97 
DTMIN  98 
DTMIN  99 
OTMIN1UO 
OTMIN1C1 
OTMIN102 
DT  MINI 03 
OTMIN104 
DTMIN1C  5 
DTMIN 10 6 
DTMIN1U7 
DTMIN108 
DT MI  Nil 9 
DTMIN110 
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•OECK, DUMPER 

SUBROUTINE  DUMPER ( X 0 . YO , ZO , TO , SI GXO , SI G YO , FM AS 
1 ISOUT  « I POU  T , MC3 ) 


H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1970 


**44  4*4  ******  *.*««*  4  4  ¥***  4  ¥******«*****'***  *  +  ♦** 

SUBROUTINE  DUMPER  WRITES  THE  NBLK  RECORDS  - 
XO  ,YO,ZO,TO,SIGXO,SIGYO,RO,PSIZ,FMAS 
ONTO  TAPE  I  POUT »  ANC  IF  MC ( 3 )  IS  NOT  ZERO,  ONT 

4**4*44***4¥************************* ************* 

DIMENSION  XOUTdOQ) ,  YOUT (100) ,ZOUT(1QO> ,TOUT(l 
DIMENSI  ON  SYOT(iOO)  ,  SXOT  (ICO)  ,  PSCTUCO  )  ,PDEP  (1 
DATA  N/O/t  NBLK/1CQ / 

80 7  FORMAT( 5X,9E12.4) 

617  FORMAT (  1H0,  23X,  6HBLOCK  0FI5,  52H  TRANSPORT 

1  WRITTEN  ON  IPOUT  TAPE/  12X,  2HXC»  ltlX,  2HY0, 

2  EHTO,  8X,  5HSIGX0,  7Xf  5HSIGY0,  9X,  2 HRO t  9X, 
8C23  FORMATt  1H0,  14X,  5  9FRESUME  PRE-TRANSPORT  PARC 

1  PARTICLE  SIZEE12.5,  7H  METERS) 

8P  24  FORMAT (  2X,  4HNSEQ,  6X ,  2HXP,  1QX,  2HYP,  10X 
1  9X  *  4HPMAS «  8X  f  4HRWAF,  7X,  4HZL0W,  8X,  4HDWA 
IF ( INCOMP*  GT.  0  )  GO  TC  8  0  63 
N  =  N  «■  1 
XOUT(N) =XO 
YOUT (N) =YO 
70U  T ( N) =70 
TOUT(N) =T0 
SXOT(N) =SI GXO 
SYOT(N) =SIG YO 
PSOT  <  N) =PSIZ 
PDEP (N) =PMAS 
ROUT(N) =R0 

IF( N. LT .NBLK)  RETURN 

COPY  OUT  BUFFER  DATA  VECTORS  ONTO  TAPE  IPOUT  IF  THEY 
8C63  WRITE(IPOUT)  N 

IF  C  MC3  .GT.  1)  WRITE (ISOUT  ,817 )  N 
IF (N.EQ.3)  RETURN 

WRITE (I  POUT)  (XCLT(M) , YOUT( M) ,ZOUT (M) .TOUT 

1R0UT(M) .PSOTCM) ,PDEP(N , M1,N> 

IF ( MC 3  .LE.  1)  GO  TC  0064 

WRITE(ISQUT,0C7)  (XOUT(H) , YOUT ( M) , ZOUT ( M ) .TOUT 
1R0UT(M)  *PSOT  t  M ) fPOEP  (M),M=1,N) 

WRITE (ISOUT, 8023)  PSIZ 
WRIT£(ISOUT,8024) 

8064  N=0 

RETURN 

END 


DUMPE  1 

,PSIZ,RO,  INCOMP,  DUMPE  2 

DUMPE  3 
DUMPE  4 

-  DECEMBER  1970  DUMPE  5 

DUMPE  6 

*44********¥***¥****q(Jhp£  7 

DUMPE  8 
DUMPE  9 
DUMPE  10 

0  TAPE  ISOUT.  DUMPE  11 

DUMPE  12 
DUMPE  13 
DUMPE  14 

QC), ROUT (103)  OUKPE  15 

00)  DUMPE  16 

DUMPE  17 
DUMPE  18 

ED  PARCEL  PROPERTI ESOUMPE  19 

luX,  2HZ0,  13  X ,  DUMPE  20 

4HPSI7,  8X.4HPMAS/) DUMPE  21 

EL  PROPERTY  LIST  F  ORDUMPE  22 

DUMPE  23 

,  2HZP,  10X,  2HTP,  DUMPE  24 

F/)  DUMPE  25 

DUMPE  26 
DUMPE  27 
DUMPE  28 
DUMPE  29 
DUMPE  30 
DUMPE  31 
DUMPE  32 
DUMPE  33 
DUMPE  34 
DUMPE  35 
DUMPE  36 
DUMPE  37 

ARE  FULL  DUMPE  30 

DUMPE  39 
DUMPE  40 
DUMPE  41 

(M,SXOT  (M)  ,SYOT(M),  DUMPE  42 

DUMPE  43 
DUMPE  *4 

(M).SXOT(MI.SYOT(M), DUMPE  45 

DUMPE  46 
OUMPE  47 
DUMPE  48 
DUMPE  49 
DUMPE  50 
DUMPE  51 


ARE  FULL 


oooooonoooo 


♦DECK*  GETOA  GETDA 

SUBROUTINE  GETOA (ASUM, ZB H, K8HA , KBHB, ND ATA, LTIM  ,  ABAR  »  KBHF,  NDATF  »  GETDA 
1LTI MF >  GETDA 

MARCH,  1971  GETDA 

SUBROUTINE  GETDA  COMPUTES  THE  AVERAGED  QUANTITY  ABAR,  WHJ'JH  HAY  BEGETDA 
A  MEASURE  OF  HORIZONTAL  ADVECTIQN,  ROTATION  OR  DISPERSION,  FROM  GETDA 

DATA  STORED  IN  THE  APPROPRIATE  ARRAY  ASUM.  GETOA 

ASUM  -  3-DIM.  OATA  ARRAY  PREPARED  IN  SUBROUTINE  SUMDAT.  EITHER  GETDA 
USUMiVSUM*  0  XSUM, DYSUM,  OR  RSUM.  GETDA 

ABAR  -  WTD.  AVG.  OVER  A  fR A Y  ASUM  FROM  INDICES  KBHA-1  TO  KBHB-1  GETDA 
K8H A  -  INDEX  OF  UPPER  STRATUM  BASE-ALTITUDE  Z3H  GETDA 

KBHB  -  INDEX  OF  LOWER  STRATUM  3 AS E- ALT ITUDE  Z BH  GETDA 

NDATA  -  HORIZ.  SPACE  INDEX  OF  ARRAY  ASUM  GETDA 

LTIM  -  UPDATE  TIME  INOEX  OF  ARRAY  ASUM  GETDA 

COMMON  /INDEX/  ICX , JCX ,KBHX , LTI MX, NA T, NC X, MOAT  X  GETDA 

COMMON  /CNTROL/  IPOU 1, ISI N , I  SO UT , JPARN , MG < 20 ) , NS EQO  GETDA 

DIMENSION  ASUMTKBHF, PDA TF , LTIMF) ,ZBH (KBHF)  GETDA 

DATA  PR0GRM/6H GETDA  /  GETDA 

CHECK  IF  KBHA-1  EXCEEDS  KBHX  GETDA 

IF(KBHA-KBHX-l)  3,2,1  GETDA 

1  1=1  GETOA 

10  CALL  ERROR(PROGRM,I, ISOUT)  GETOA 

ABAR=0.  GETOA 

RETURN  GETOA 

2  ABA R=ASUM(KBHA-1, NDATA, LTIM)  GETOA 

RETURN  GETOA 

3  ABA R=ASUM(K8HA~i,NQATA, LTIM)  GETDA 

CHECK  IF  KBHB  IS  LESS  THAN  1  GETDA 

IF(KBHB-l)  6,5,4  GETDA 

6  1=6  GETDA 

GO  TO  10  GETDA 

CONCLUDE  ABAR  COMPUTATION  GETDA 

4  ABA  R-- ABAR- A  SUMCKBHB-l, NDATA, LTIM)  GETDA 

5  ABAR=A3AR/(ZBH(KBHA)-ZBH (KBHB))  GETDA 

RETURN  GETOA 

ENO  GETOA 


2 

3 

4 

5 

6 
7 
6 
9 

10 

11 

12 

13 

1 4 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 
Z5 
26 

27 

28 

29 

30 

31 

32 

33 
3<* 

35 

36 
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*0ECK, GETUP  GETUP 

SUBROUTINE  GETUP < NET , NETSU , MARY , MA RF , ICF  ,  JCF , NCF  ,NDA TF )  GETUP 

GETUP 

MARCH,  1971  GETUP 

GETUP 
GETUP 

SUBROUTINE  GETUP  PREPARES  THE  HORIZONTAL  SPACE  CONTROL  NET  GETUP 

ARRAYS  NET (  IC,  IC  )  ANO  NETSU  t  NC  )  FROM  DATA  PROVIQEO  EY  THEGETUP 
JSER  IN  THE  GRID  SPECIFICATION  ARRAY  MARY (  MARK  ).  GETUP 

GETUP 

THE  SUBSCRIPTS  IC  ANO  JC  OF  THE  TWO-CI ME  NS  I C NA L  ARRAY  GETUP 

NET (  IC,  JC  »  LOCATE  (  SYMBOLICALLY  )  THE  CENTERS  OF  CONTIGUOUS  GETUP 
UNIT  MESH  SQUARES  (  CF  DIMENSION  HINT  >  RELATIVE  TO  THE  UNIT  GETUP 

SQUARE  IN  THE  SOUTH-WEST  CORNER  OF  THE  NET.  FOR  THIS  SOUTH-WEST  GETUP 

CORNER  UNIT  MESH  IC  =  JC  =  1.  IC  IS  INCREMENTED  IN  THE  GETUP 

EASTERLY  DIRECTION  AND  JC  IS  INCREMENTED  IN  THE  NORTHERLY  GETUP 

DIRECTION.  GETUP 

GETUP 

ON  FIRST  PASS  THROUGH  THE  ELEMENTS  OF  MARY  C  MARK  )  EACH  POSITI  i/EGETUP 
INTEGER  FLAGS  A  PARTICULAR  NON-SUBOI VI OED  UNIT  MESH  SQUARE.  A  0  GETUP 
FLAGS  A  PARTICULAR  SUBDIVIDED  UNIT  MESH  SQUARE.  GETUP 

A  UNIQUE  VALUE  OF  NOATA  (  THE  ARRAY  INDEX  WHICH  REFERENCES  ALL  OF  GETUP 
THE  ATMOSPHERIC  DATA  ARRAY  ELEMENTS  ASSOCIATED  WITH  THIS  UNIT  GETUP 
SQUARE  )  IS  STORED  IN  NET (  IC,  JC  ).  GETUP 

GETUP 

WHEN  ZERO  IS  FOUND  IN  AN  ELEMENT  OF  MARY (  MARK  )  ,  GETUP 

NC  (  THE  ARRAY  INOEX  WHICH  REFERENCES  A  STARTING  LOCATION  IN  THE  GETUP 

ARRAY  NETSU  <  NC  )  )  IS  STORED  IN  NEK  IC,  JC  )  AS  A  NEGATIVE  GETUP 

INTEGER  -NC.  GETUP 

GETUP 

MARYC  MARK  )  IS  ERASED  AND  RELOADED.  ON  SECOND  PASS  THROUGH  GETUP 

THE  ELEMENTS  OF  M ARY (  MARK  ),  THE  ELEMENT  NC  OF  THE  ARRAY  GETUP 
NETSU  (  NO  »  WILL  BE  IOAOEO  WITH  CONTROL  DATA  FERTAI NING  TO  THE  GETUP 


LOWER-LEFT  QUADRANT  OF  THE  SU80IVI0EU  MESH  SQUARE.  THE  SUCCEEDINGGETUP 


THREE  ELEMENTS  (  NETSU  (  NC  +  1  ),  NETSU  (  NC+2  ),  NETSU  (  NC  +  3  >  )  GETUP 
WILL  BE  LOAOED  WTTH  CONTROL  DATA  PERTAINING  TO  THE  OTHER  THREE  GETUP 
QUADRANTS,  PROCEEDING  CLOCKWISE  FROM  THE  FIRST  QUADRANT.  THESE  GETUP 

CONTROL  DATA  WILL  BE  ADDITIONAL  NOATA  OR  NC  VALUES  FLAGGED  BY  GETUP 
MARY (  MARK  ).  GETUP 

GETUP 

PROCESSING  CONTINUES  UNTIL  NO  ADDITIONAL  ELEMENTS  NC  ARE  FLAGGEDGETUP 
BY  MARY (  MARK  ).  GETUP 

GETUP 

COMMON  /CNTROl/  I  POUT ,1  SI N , I SOUT , JP ARN , MC < 2 0 ) , NS EQO  GETUP 

COMMON  /INDEX/  ICX , JCX, KBH X , LT IMX, NAT , NCX , NDAT X  GETUP 

DIMENSION  NET  < ICF , JCF ) ,  NETSUt  NCF),  M A  RY (  MARF) GETUP 

DATA  PR0GRM/6HGETUP  /  GETUP 

C  GETUP 

1000  FORMATt  3612  )  GETUP 

lQill  FORMAT  (  1H0,  25X,  3 1PARRAY  MARY  HAS  BEEN  LCACED  WITH, 15,  22H  ELEMEGETUP 
1NTCS)  AS  FOLLOWS/)  GETUP 

1002  FORMAT  <25X,36I2)  GETUP 


1 

2 

3 

A 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 
27 
26 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 
*0 

41 

42 
h3 

44 

45 

46 

47 
46 

49 

50 

51 

52 


MSECT  =  4 
MNEG  =  1  -  MSECT 
NOATA  =  0 
IC  =  0 
JC  =  1 

IFdCX.GT.  ICF)  CALL  ERROR  (PROGRM.-l,  ISOUT) 
IF C JCX.GT. JCF)  CrtLL  ERROR(PROGRM,-l, ISOUT) 

118 


ttv:"/'.  333C3ME3Bg 


GETUP  53 
GETUP  54 
GETUP  55 
GETUP  56 
GETUP  57 
GETUP  58 
GETUP  59 
GETUP  60 


~-j  <r<  vn  i\j  h- 


MARX  =  ICX  *  JCX 
00  2  MARK  «  i,  HARE 
MARY (  MARK  )  =  -9 

IFCMARX.GT.MARF)  CALL  ERROR  (pR0GRM»-2t  I  SCUT  I 
REAOflSIN, 1000 >  (MARYiMARKi  ,Mf,RK=i,M ARX) 

WRITE (ISOUT,1001)  MARX 

WRITE(ISOUT,iOC2>  ( MARY ( MARK) , MARK=1 ,MARX> 

MARK  =  0 
MCTR  =  0 
MARK  =  MARK  f  1 
IE (  MARK  -  MARX  )  5,  5,  4 
MARX  =  MSECT  *  MCTR 
IF (  MARX  )  6,  14,  1 

IF (  MARY <  MARK  »  )  6.  7,  8 

CALL  ERROR  ( PROGRM,  -  6  ,,I SOUT  ) 

MNEG  =  MNEG  *■  MSECT 
NQQ  =  -  MNEG 
MCTR  =  MCTR  ♦  1 
GO  TO  9 

8  NOATA  =  NDATA  *  1 

NQQ  =  NDATA 
NDATX  =  NDATA 

IF(NDATX.GT.NDATF)  CALL  ERROR (PROGRM,-fl ,ISOUT) 

9  IC  *  IC  ♦  1 

IF (  JC  -  JCX  )  10,  10,  13 

10  IF (  ic  -  ICX  )  12,  12,  11 

11  JC  =  JC  *■  1 
IC  =  0 

GO  TO  9 

12  NET (  IC,  JC  )  =  NQQ 
GO  TO  3 

13  NC  =  IC 

NETSU (  NC  »  =  NQQ 

NCX  =  NC 

IT ( NCX, GT.  NCF)  CALL  ERROR { PROGRM ,-13 , 1 SOUT ) 

GO  TO  3 

14  RETURN 
ENO 


GETUP  61 
GEYUP  62 
GETUP  63 
GETUP  64 
GETUP  65 
GETUP  66 
GETUP  67 
GETUP  68 
GETUP  69 
GETUP  70 
GETUP  71 
GETUP  72 
GETUP  73 
GETUP  74 
GETUP  75 
GETUP  76 
GETUP  77 
GETUP  78 
GETUP  79 
GETUP  80 
GETUP  81 
GETUP  82 
GETUP  83 
GETUP  84 
GETUP  85 
GETUP  86 
GETUP  87 
GETUP  88 
GETUP  89 
GETUP  90 
GETUP  91 
GETUP  92 
GETUP  93 
GETUP  94 
GETUP  95 
GETUP  96 
GETUP  97 
GETUP  98 
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♦DECK.  LAYERS 

SUBROUTINE  LAYERS  (ZCF,ZBH,KBHF> 

K.  G.  NGRMENT,  A  TKCSFHERIC  SCIENCE  ASSOCIATES  -  OECEHBER  1976 

*■***»******♦♦*■;  *»**V*A*-*»***-*#*->  +  »jf*«.^*.*»********#^j**.»t>  **♦*****♦«■*  f. 

CONSTRUCTS  THE  ATMOSPHERE  STRAT I FICA TI ON  ARRAYS  Z3H  AND  ZGH  FOR 
THREE-DIMENSIONAL  WIND  AND  TURBULENCE  FIELDS. 

ZBH  CONTAINS  STRATA  EASE  ALTITUDES  AND  ZCH  CONTAINS  STRATA  CENTER 
ALTITUDES  (BCTH  RELATIVE  TO  MEAN  SEA  LEVEL ) (METERS) 

»>**».»**»*#*>  »**«.♦*♦**♦  V  **  ***¥***»■***•**>«'***•*•»*■¥•  +  *■***•¥■  4  ♦  *  ■***•¥*** 

COMMON  /CNTRQL/  IPO  LT  ,  IS  IN ,  ISOU  T  ,  JPARN  ,MC  t'  20  ) ,  NS  EQO 
COMMON  /INDEX/  ICX  ,  JCX , K BH X , LTIMX ,N AT , NCX, NDA TX 
COMMON  /SPACE/  HINT , XLLO ,YLLC, ZMAX ,Z MI N , TIMEX 


INTEGER  BASALT ,CNT ALT, TLAYR 
DIMENSION  ZBH(KBHF)  ,ZCH(KBHF) ,  ENTRY ( 8  ) 
DATA  PROGRM  , 8ASAL T  .CNTALT  ,EPSZ 

/6HLAYERS  .4HBASE  , 4HCENT  ,  0.1 


, ALIMIT  , IREC 
,  999y99.  ,  e 


1  FORMAT  <  J.9X,  6HLEVELS,  14,  5H  THRU.I4/25X,  8F12.5) 

2  FORMAT  i  8F1C . C ) 

3  FORMAT ( 1H0,  48X,  25HWIN0  LAYER  BASE  ALTITUDES/) 

4  FORMAT  ( 1HC  43X,  27HWINC  LAYER  CENTER  AlTITUOES/) 

5  FORMAT (  1 1 X  A4) 

G  FORMAT ( 1H0, 25X, 31HMAXIMUM  WINO  SPACE  A  LTITUOE  IS  E12.5.7H  METERS) 

6  FORMAT  ( 1HC  ,I0X,  45»!ZBH(i)AN0  ZMIN  DO  NUT  AGREE  WITHIN  TOLERANCE  ,E 

11Z. 5) 

C 

COPY  IN  DATA  TYPE  (LAYER  EASE  OR  CENTER  ALTITUDE)  INDICATOR 
REAQ(ISIN,5)TLAYR 

COPY  WIND  LAYER  ALTITUDES  INTO  ARRA /  ZCH 
K=0 

20 C  REA0(ISIN,2) (ENTRY (I), 1=1, IREC) 

OG  231  1=1, IREC 

If (ENTRYtl) ,GE. ALIMIT)  GO  TO  2G2 
IF ( ENTRY ( I )  .LT.  0.0)  GO  TO  201 
K  =  <*1 

IF(K.GT.KBHF)  CALL  ERROR (PROGRM, -201, I SOUT) 

ZCH  (K )  =  ENT RY  < I ) 

201  CONTINUE 
GO  TO  200 

202  K3H  X=  K 

CCNMINGLE  THE  LAYER  ALTITUDES  INTO  ASCENDING  0*CER 
KBHt:i=<BHX-l 
DO  210  1=1 , KBHM 1 
IP1=I+1 

DO  210  J=IP1,KBHX 

IF  (ZCh( I).LE.ZCH(J) )  GO  TC  2lC 

TEMP=  ZCH ( I ) 

ZCH ( I)  =  ZCH ( J ) 

ZCH ( J )  =  TEMP 
210  CONTINUE 

COMPUTF  LAVi'R  CENTER  OR  BASE  ALTITUDES  DEPENLING  ON  WHICH  HERE  INPU) 

IF( TLAVR.EQ. CNTALT) GC  TO  250 
230  IF (TLAYR. NE^BASALT) CALL  ERROR  5 PROGRM ,- 23 0 , I SCU T ) 
Ir(ABS(ZCH(l)-ZMIN)  ,LE,EPSZ)GO  TO  235 

120 


LAYER  1 
LAYER  2 
LAYER  3 
LAYER  4 
LAYER  5 
LAYER  6 
LAYER  7 
LAYER  8 
LAYER  9 
LAYER  10 
LAYER  11 
LAYER  12 
LAYER  13 
LAYER  14 
LAYER  15 
LAYER  16 
LAYER  17 
LAYER  18 
LAYER  19 
LAYER  20 
LAYER  21 
LAYER  22 
LAYER  23 
LAYER  24 
LAYER  25 
•.AYER  26 
LAYER  27 
LAYER  28 
LAYER  29 
LAYER  30 
LAYER  31 
LAYER  32 
LAYER  33 
LAYER  34 
LAYER  35 
LAYER  36 
LAYER  37 
LAYER  38 
LAYER  39 
LAYER  40 
LAYER  41 
LAYER  42 
LAYER  43 
LAYER  44 
LAYER  45 
LAYER  4b 
LAYER  47 
LAYER  48 
LAYER  49 
LAYER  50 
LAYER  51 
LAYER  52 
LAYER  53 
LAYER  54 
LAYER  55 
LAYER  5b 
LAYER  57 
LAYER  58 
LAYER  59 
LAYER  60 


WRI TE  ( I  SOUT  »3  )  EPSZ 

LAYER 

61 

234 

CALL  £RR0R<PR0GRM,-234* ISOUT) 

LAYER 

62 

235 

ZCH ( 1 )  =  ZHI N 

LAYER 

63 

CONSTRUCT  MIND  LAYER  CENTER  ALTITUDES  IN  ARRAY 

ZCH  A NL  LOAC  BASE 

LAYER 

64 

C 

ALTITUDES  INTO  Z3H 

LAYER 

65 

DO  240  K=1  , KQHHl 

LAYER 

66 

ZBH (K )  =  ZCH  (  Kil 

LAYER 

67 

240 

ZCH  (K  J  -  iZCHJK)  ♦  ZCMK  +  1) )  /2«Q 

LAYER 

68 

ZBH  C KBKX)  =  ZCH i KBHX ) 

LAYER 

69 

ZCH  (KBHX)  =  2*  0  *  BH  (  K8HX  )  -  ZCH(KBHX-l) 

LAYER 

70 

GO  TO  300 

LAYER 

71 

CONSTRUCT  MIND  LAYER  BASE  ALTITUDES  IN  ARRAY 

ZBH 

LAYER 

72 

250 

ZBH  111® ZHI N 

LAYER 

73 

DO  260  1=2  tKBHX 

LAYER 

74 

260 

Z8Hd)  =  2«0*ZCH(l>l)  -  ZBH  Cl -1 ) 

LAYER 

75 

300 

ZSAX  =  2.  0*ZCHIKBHX) -ZBH(KBHX) 

LAYER 

76 

COPY  i 

OUT  HIND  LAYER  OATA 

LAYER 

77 

WRITE  < ISOUT 1 6 ) ZMAX 

LAYER 

78 

WRITE (ISOUT  «3 ) 

LAYER 

79 

00  301  IGO=l,KBHX, IREC 

LAYER 

30 

1ST  OP=I GO* IREC -l 

LAYER 

81 

IFdSTOP.GT.KBHX)  IST0P=K8HX 

LAYER 

82 

301 

WRITE(ISOUT»l) IGCjISTOP* (ZBH(K) ,K=IGO, ISTOP) 

LAYER 

83 

WRITE d  SOUT  f 4 ) 

LAYER 

84 

DO  313  IG0=i»K8HX,IREC 

LAYER 

85 

ISTOP=IGOfIREC-l 

LAYER 

86 

IFdSTOP.GT  .KBHX)  ISTOP  =  KBHX 

LAYER 

67 

30  3 

WRITE(ISOUT,l)IGC,ISTOP,  (ZCH(K)  ,  K=IGO«  ISTOP! 

LAYER 

o  8 

RETURN 

LAYER 

69 

END 

LAYER 

90 
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♦DECK, NEST  NEST 

SUBROUTINE  NEST (NET ,NETSU, XQ, YQ.N3ATA, XL ,XR,YL ,YU, ICF, JCF.NCF)  NEST 
MARCH,  1971  NEST 

GIVEN  THE  HORIZONTAL  COORDINATES  OF  A  POINT,  NEST  RETURNS  THE  NEST 
NET  MESH  OR  SUB-MESH  INDEX  NOATA  AND  THE  BOUNDARY  COORDINATES  0F  NesT 
THE  MESH  OR  SUB-MESH  NEST 

MESH  INOEX  IS  -999  IF  INPUT  POINT  LIES  OLTSIOE  ATMOS.  NEST 

NET  -  PRIMARY  HORIZONTAL  SPACE  RESOLUTION  MESH  ARRAY  NEST 

NETSU  -  HORIZONTAL  SPACE  RESOLUTION  SUB-MESH  ARRAY  NEST 

XQ  -  INPUT  POINT  >  COORDINATE  NEST 

YQ  -  INPUT  POINT  Y  COORDINATE  NEST 

NDATA  -  OUTPUT  MESH  CR  SUB-MESH  INOEX  NEST 

XL  -  OUTPUT  MESH  OR  SUB-MESH  LEFT  BOUNDARY  X  COORDINATE  NEST 

XR  -  OUTPUT  MESH  CR  SUB-MESH  RIGHT  BOUNDARY  X  COORDINATE  NEST 

YL  -  OUTPUT  MESH  CR  SUB-MESH  LOWER  BOUNDARY  Y  COORDINATE  NEST 

YU  -  OUTPUT  MESH  CR  SUB-MESH  UPPER  BOUNDARY  Y  COORDINATE  NEST 

COMMON  /CNTROL/  IPO LT, I S I N , I SOUT  , JPARN , MC < 2 0 > , NS EQO  NEST 

COMMON  /INDEX/  ICX  ,  JCX  ,  k'BHX ,  LTI  MX  ,N  AT  ,  NC  X ,  NCA  T X  NEST 

COMMON  /SPACE/  M IN  1,  XLLC ,\'LLC ,  ZM AX, Z MI N,  TIMEX  NEST 

DIMENSION  NET (ICf ,JCF)  ,NETSU(NCF  )  NEST 

DATA  PR0GRM/6HNEST  /  NEST 

COMPUTE  MESH  INDICES  IC  ANC  JC  FOR  ( XQ, YQ)  NEST 

IC=(XQ-XLLC)/WINT+1.  NEST 

JC=<YQ-YLLC)/WINT*1.  NEST 

COMMENCE  MESH  SEARCH  NEST 

CHECK  IF  IC  (JG)  LIES  BETWEEN  1  AND  ICX  (JCX)  NEST 

IF ( (IC. GE.l), AND. ( JC.GE.l) .AND. (IC.LE, ICX) .AND, (JC.LE.JCX) ) GO  TO  1NEST 
CANCEL  MESH  SEARCH.  (XQ.YC)  LIES  OUTSIOE  ATMOS.  NEST 

N0ATA=-999  NEST 

RETURN  NEST 

COMPUTE  XL, XR, YL.  ANO  YU  FOR  MESH  NEST 

1  VINT  =  WI NT  NEST 

XL=  VINT*FLO AT ( IC -1) +  XLLC  NEST 

XR=VINT*FLOAT(IC)*XLLC  NEST 

YL=  VI NT* FI  OAT  (  JC-1 )  +YLLC  NEST 

YU=VINT  Vl_0AT<  JO+YLLC  NEST 

CHECK  SIGN  OF  MET(IC,JC>  NEST 

IF (NET ( IC, JC) )  4,2,1  NEST 

2  CALL  ERRQR(PR0GRM,-2,IS0UT)  NEST 

CONCLUOE  MESH  SEARCH  NEST 

3  NDAT4=NET(IC, JC)  NEST 

RETURN  NEST 

COMMENCE  QUADRANT  SEARCH.  OBTAIN  POINTER  NQ  NtST 

4  NQ=«NET  (IC, JC)  NEST 

COMPUTE  QUADRANT  INDICES  IC  AND  JG  FOR  IXQ.YG)  NEST 

5  VINT  =  VI NT/ 2 •  NEST 

IQ=(XQ-XL)/VINT  NEST 

JQ=(YQ-YL)/VINT  NEST 

CONVERT  NQ  TO  QUAORANT  LABEL  NEST 

NQ=NQ*3*IQ»JQ-2*IQ* JC  NEST 

COMPUTE  XL , XR , YL ,  ANO  YU  FCR  QUAORANT  NEST 

XR=XL  +  V I  NT* FLO AT  (IQ<  1)  NEST 

XL=XL*VINT*FLOAT(IC)  NEST 

YU= YL+V INT*FL  OAT(JC*l)  NEST 

YL  =  YL*VINT*FLOAT  (JQ)  NEST 

CHECK  SIGN  OF  NETSU(NQ)  NEST 

IF (NETSU(NQ) )  7,6,8  NEST 

6  CALL  ERR0R(PR0GRM,-6,IS0UT)  NEST 

CONTINUE  QUAORANT  SEARCH,  OBTAIN  POINTER  NQ  NEST 

7  NQ= -NET  SU ( NQ*  NEST 
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GO  TO  5 

NEST 

61 

CONCLUDE  QUADRANT  SEARCH 

NEST 

62 

8  NDATA=NETSU (NQ) 

NEST 

63 

RETURN 

NEST 

64 

END 

NEST 

65 

♦DECK, ONEDIN  ONE  D I 

SUBROUTINE  ONEDIN(ZCH,ZBH,CAVS,OX  *DY  , LTx M , KBHF , NOA TF , LTI MF ,  ONEDI 
1  FORM, SPEC)  ONEDI 

ONEDI 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  “  DECEMBER  1978  ONEDI 

ONEDI 

4MMMt  ***#*#¥***##*  «*#*«*«****4*L.,  ♦*  +  **¥#•*#**♦  ONEDI 

ONEDI 

READS  AND  PROCESSES  HIND/TURBULENCE  DATA  FOR  A  HORIZONTALLY  ONEDI 

HOMOGEN IOUS  FIELD.  VERTICAL  COMPONENTS  ARE  NOT  CONSIDERED.  ONEDI 

ONEDI 

«*«*##*  +  4**  44  **44  44  *4 ¥****4  444444  4*4*4*  *4*  44444*444  4  4  4444*4***4*4  4  ON  ED  I 

ONEDI 

COMMON  /CNTRQL/  IPOUT, IS  IN , ISOUT , JPA RN , MC (20 ) , N SEQO  ONEDI 

COMMON  /INDEX/  IC X , JCX , KQHX, LTIMX , N AT 5 NCX, NOA TX  ONEDI 

COMMON  /SPACE/  MINT , XLLC, Y LLC ♦ ZMAX ,Z MI N , TIMEX  ONEDI 

C  ONEDI 

INTEGER  WINO, TURB, METEOR, RESOLV, SPEC, FORM  ONEDI 

DIMENSION  ZCH(KBHF) , Z8H ( KBHF) , DX (KBHF , NOAT F , LT IMF) ,CAVS(K3HF>  ONEDI 

OIMENSION  FMT( 1Z)  ,SCALE(5) ,  AP(3I,  D Y ( KBHF,  NDATF,  LTIMF)  ONEOI 

C  ONEDI 

DATA  ALIMIT  ,  RAOC  ,  PROGRM  ,  METEOR  ,RESCLV,  HIND  ,  TURB  ONEDI 

1  /  999999.  ,.0  174532925,  6H0NE0IN,  4HMETE  ,4  HR E30, 4HMI NO , 4HTUR B/ONED I 

DATA  IR EC/8/  ONEDI 

C  ONEDI 

1  FORMAT (  4X ,  6HLEVELS, 14,  5H  THRO, 14,  8F12.5)  ONEOI 

3  F0RMAT(  ////33X,  25HWIN0  LAYER  8 ASE  ALTITUDES/)  ONEDI 

4  FORMAT (1H03X31HMAXIMUM  WIND  SPACE  ALTITUDE  IS  E12.5,7H  METERS)  ONEDI 

1C  r  a  FORMAT  (12A6)  ONEDI 

1130  FORMAT  (8F1Q.0)  ONEOI 

1200  FORMAT  (2014)  ONEDI 

1300  FORMAT (  16X,  13HRAW  RIND  DATA ,33X, 19HPROC ESSED  WIND  DATA//8 X, ONEDI 

11HZ,  9X,  10HVX  OR  OIR.,  3X,  11HVY  OR  SPEED,  14 X ,  1HZ,  12X,  ONEDI 

2  2HVX,  12X,  2HVY/)  ONEDI 

1400  FORMAT  <3<2X,  1PE12.5))  ONEOI 

1500  FORMAT  (1H+  47X,  3(2X,  1PE12.5))  ONEDI 

1600  FORMAT (  1QX19HRAW  TURBULENCE  0 A TA , 28 X 2 5H PROCE SS ED  TURBULENCE  OATAUNEDI 

1//3X,  1HZ,  1CX,  4HEPSX,  10X,  4HEPSY,  17X,  1HZ,  11X  4HEPSX,  10X,  ONEOI 
2  4HEPSY / )  ONEDI 

1700  FORMAT  (  lHli,  5X ,  63HNUMeER  OF  WIND  OR  TURBULENCE  INPUT  DATA  INCONONEDI 
1SISTENT  FOR  UPDATEI4)  ONEOI 

1800  FORMAT  (  1H0,  5X,  59PHN0  OR  TURBULENCE  STRATA  ALTITUDES  INCONSIS  TEONEOI 
1NT  FOR  UP0ATEI4)  ONEOI 

C  ONEOI 

CHECK  FORM  ANO  SPEC  ONEDI 

IF ( SPEC  ,EQ.  WINO  .AND.  FORM  . EQ .  METEOR)  GO  TO  25  ONEDI 

20  IF ( Spl C  .EQ.  WINO  .AND.  FORM  ,N£.  RESOLV)CAlL  ERROR (PROGRM, -20 ,  ONEOI 

1  ISOUT)  ONEDI 

COPY  IN  FORMA  T  t  SCALE  8.  FIELC  POINTERS  ONEDI 

25  READ  ( I  SIN ,  10C0)FMT  ONEDI 
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K3HX ) 


REA  0  ( I  SIN  «  11001  SCALE 
REAO  (I3IN,  1200)  Nl,  N2,  N3 
DO  50  I  =  1,3 

50  IF (SCALE (I) •  EQ,  0.0)  SCALE  (I)  =  1.0 

IF (FORM  .EQ.  METEOR)  TRNS=SCALE ( 5) *S CALE ( 3 )  - 
IF( MC (2 )  .NE.  1  .AND.  SPEC  .EQ.  WIND)  WRITEt 
IF ( MC ( 2 )  .NE,  1  .ARC.  SPEC  .EQ.  TURB)  WRITEt 
KBH  —  0 

COPY  IN,  PRINT  RAW  DATA,  TRANSLATE  ANO  SCALE  OATA,  A 
C  DATA 

100  READ  ( I  SIN ,  FMT)  AP 

IF(AP(N1).GE.ALIMIT)G0  TO  250 

IF  ( MC  {  2  I  .NE.  1  )  WRITEdSOUT,  14G0)AP(N1 

KBH  =  KBH  ♦  1 

CAVS (KBH) =  (AP(N1)  +  SC ALE ( 4 ) ) *  SCALE  (1 > 

IF( FORM .EQ .RES  OL  V)  GO  TO  150 

OX< K3H,1,LTIM) = AP ( N3 ) *SC ALE ( 2 ) ♦ SIN ( RADC* ( AP (N2 
DY  CKBH,1,LTIM)  =AP(N3  F*  SCALE  < 2 )  *CGS  ( RAO C *  ( AP  < N2 
GO  TO  200 

150  OX  (  KBH,  1 ,  LT IM)  =  AP  (  K2  )♦  SCA  LE  ( 2  ) 

OY ( KBH, 1,LTIM)  =  AP  (N3) ♦SCALE ( 2 ) 

230  IF C MC (  2) .NE.  1) WRITE  (ISOUT,  1503  )CAVS  (KBH)  , 
IDYtKBH,  1,  LTIM) 

GO  TO  100 

250  IF ( LTI M  .EQ.  1)  KBH X=KBH 

CHECK  IF  THE  NUMBER  OF  DATA  VECTORS  IS  CONSISTENT 

251  IF < LTIM  .EQ.  1  .OR.  KBH  .EQ.  K3HX )  GO  TO  253 
WRITEdSOUT  ,1700  )  LTIM 

COMMINGLE  OATA  TO  ARRANGE  IT  IN  ORDER  OF  ASCENDING  A 
253  KBHM1  =  KBHX  -  1 
DO  255  1=1 , KBHM1 

ipi=im 

DO  255  J=IP1, KBHX 

IF(CAVS(I)  .LE.  CAVS(J))  GO  TO  255 
TEMP=CAVSd> 

CA  VS (I ) =CAVS< J) 

CAVS ( J) =TEMP 
TEMP*OX  <1,1, LTIM) 

DX<I,1,LTIM)  =  DX(J,1,LTIM) 

OX(J,i,LTIM)=TENP 
TEMP=  OY (1,1, LTIM) 

DY<I,l,LTIM)=OY(J,  i.LTIM) 

OY (J,1,LTIM)=TEMP 
255  CONTINUE 

IF ( LTIM  .EQ.  1  .ANC.  SPEC  .EQ.  WIND)  GO  TO  255 
CHECK  STRATA  ALTITUDES  AGAINST  THOSE  FOR  THE  LTIM=1 
DO  258  1=1 ,KBHM1 

IF  (CAVS  (I)  .GE.  ZBHd)  .ANO.  CAVS(I)  .LE.  ZBH< 

WRITEdSOUT,  18  00)LTIM 

CALL  ERROR(PROGRM,-256,  ISOUT) 

258  CONTINUE 
RETURN 

CONSTRUCT  WIND  LAYER  8ASE  ALTITUOES  IN  ARRAY  Z6H  A 
C  ALTITUDES  INTO  ZCH 

259  ZBHd)  =  Z  MIN 
ZCH  < 1 )  =  CAV  S (1 ) 

DO  260  1=2, KBHX 
ZCH  < I )  =  CAVS <I) 

260  ZBH(I)  =  2.0*ZCHd-l)  -  ZBHd-i) 

ZMAX=2. 04ZCH( KBHX) -ZEH( KBHX) 


160. 

IS CUT, 1300) 
IS  CUT, 1600) 


SCALE  OATA,  AND  PRINT  PROCESSED 


14  G  3 )  A  P  (  Nl )  ,  AP<  N2)  ,  AP(N3) 


)  ♦SCALE  (3)  TRNSH 
)  *SCALE<3)  TRNS)  ) 


OX  (KBH,  1,  LTIM), 


LT  ITUOE 


CHECK 


NINO  DATA 


1*1) )  GO  TO  256 


NO  LOAD  CENTER 


OMEOI  51 
ONEDI  52 
ONEOI  53 
ONEOI  54 
ONEOI  55 
ONEDI  56 
ONEDI  57 
ONEDI  56 
ONEOI  59 
ONEOI  60 
ONEDI  61 
ONEOI  62 
ONEDI  63 
ONEDI  64 
ONEDI  65 
ONEDI  66 
ONEDI  67 
ONEDI  66 
ONEDI  69 
ONEDI  70 
ONEDI  71 
ONEDI  72 
ONEDI  73 
ONEDI  74 
ONEDI  75 
ONEDI  76 
ONEDI  77 
ONEDI  78 
ONEDI  79 
ONEDI  80 
ONEDI  SI 
ONEDI  62 
ONEDI  83 
ONEDI  84 
ONEOI  85 
ONEOI  86 
ONEOI  67 
ONEDI  68 
ONEDI  89 
ONEDI  90 
ONEDI  91 
ONEDI  92 
ONEDI  93 
ONEDI  94 
ONEDI  95 
ONEDI  96 
ONEOI  97 
ONEDI  98 
ONEDI  99 
UNEDIluO 
ONEDI 131 
ON  EDI  1 32 
ONEOI 1 0  3 
ON  ED  1 1  o  4 
0NEDI1Q5 
ONEDI 136 
UNE0I1J7 
ONEOI 138 
0NE0I139 
ONEDI  110 
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COPY  OUT  WINO  LAYER  BASE  CATA  ONEOI111 

WRITE(ISOUT,3>  0NE0I112 

DO  27 0  IGO=l,KBHX,IREC  ONtDI113 

ISTOP=IGO*IREC-i  ON  ED  1 114 

IF(ISTOP.GT.KBHX)  ISTOP=KBHX  0NL0U15 

270  WRITE  fl'SOJT,i)IGC,  ISTOP,  (ZBH(K)  ,  K=IGO,  I  STOP)  0NEDI116 

WRIT£(IS0UT»4) ZMAX  0NEDI117 

RETURN  ONEDI118 

ENO  0NE0H19 


♦DECK,  SPRVS  SPRVS 

SUBROUTINE  SPRVS (NE T .NET $U , ZBH , ZCH, TIMUP.USUM,  VSUM, OXSUM ,DYSUM ,  SPRVS 

1RSUM,  WFZ,CAVS,HOAV,TSUM,WAVG,ALT,AIP,PRS,RLH,RHC,ETA  ,  SPRVS 

2ICF, JCF,NGF,KBHF,NCAIF,L71MF,NATF)  SPRVS 

SPRVS 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  SPRVS 

SPRVS 


»»*  +  ****  *+*  +  *****  +  *****■*•  +  ■*■**  +  +  +  +  *  + 


SPRVS 

SUBROUTINE  SPRVS  SUPERVISES  OIFFUS IVE . T RANSPOR T  SPRVS 

OF  FALLOUT  PARCELS  LISTED  ON  TAPE  JPARN.  PARCEL  PARAMETERS  ARE  SPRVS 
STORED  IN  ARRAYS  XP AR , YP AR , ZPAR, TPAR ,POAM, PS AM , R WFR, DWFR , ZL WF, VH FRSPRVS 
ONLY  ONE  PARCEL  IS  TRANSPORTED  AT  A  TIME.  FOP  THIS  PARCEL  ABOVE  SPRVS 
ITEMS  ARE  STOREO  IP  XP, YP. ZP, TP , PS IZ ,P MAS, RWAF ,OWAF , ZLOW , V WAF.  SPRVS 
XPAR  -  X  COORDINATE  OF  PARCEL  CENTER  SPRVS 

YPAR  -  Y  COORDINATE  OF  PARCEL  CENTER  SPRVS 

ZPAR  -  Z  COORDINATE  OF  PARCEL  CENTER  SPRVS 

TPAR  -  TIME  OF  OEFINIYICN  OF  CLOUD  PARCEL  SPRVS 

POAM  -  MIOPOINT  OF  FARCEL  PARTICLE  SIZE  CLASS  SPRVS 

PSAM  -  TOTAL  MASS  OF  PARCEL  SPRVS 

PWFR  -  RAOIUS  OF  PARCEL  AT  CENTER  OF  MASS  SPRVS 

OWFR  -  PARCEL  THICKNESS  SPRVS 

ZLWF  -  ALTITUDE  OF  FARCEL  BASE  SPRVS 

VWFR  -  PARCEL  VOLUME  SPRVS 

SPRVS 

***»«**«**«**«»*«»«**««*«*««»*«»***»***« ««> «*«**#* »**»**«*#*»«*#*#«*¥*»  sp|^y/s 

SPRVS 

COMMON  /CNTROL/  I  POUT, ISI N , I SOUT , JPARN  ,  MC ( 20 ) , NS EQO  SPRVS 

COMMON  /INOEX/  ICX , JCX ,KBH X , LTIMX ,N AT , NCX, NOA T X  SPRVS 

COMMON  /PAfiCL/  CRC SS , 00 WN , 0 WAF , EDDY ,ND ATP ,PMA S , PS IZ , RHOP , RW AF ,  SPRVS 

1  TP,XP, YP.ZLOW.ZP  SPRVS 

COMMON  /SPACE/  HINT  ,  XLLC  ,YLLC , ZMAX , ZMI N , TI MEX  SPRVS 


DIMENSION  ALT (NATF )  ,  ATP (N ATF) ,PRS ( NATF ) , FHC < NA TF ) , ET A (NA TF) 
DIMENSION  NET (ICF, JCF) , NETSU (NCF > , ZBH ( KBHF ) , ZC H (KB HF > , HO A V ( L TIMF > 
DIMENSION  USUM (KBHF.KOAT  F.tTIMF) , VSUM ( KBHF, NDATF ,LTIMF) ,CAVS  (KBHF) 
DIMENSION  OXSUM <KBHF,NOATF,LTIMF) ,DY SUM (KBHF, NDATF, LT IMF) 

DIMENSION  WFZ (KBHF, NCATF.LT IMF) , KA VG < KBH F , LT IM F) ,T IMLP (L TI MF ) 
DIMENSION  RSUM(K8HF,K0ATF,LTIMF) ,T SUM (KBHF) 

DIMENSION  XPAR  (If  0)  ,  YPAR  ( 10  0  ) ,  ZPAR  <  lilO  ) ,  TP  AR  <  i  0  u  ) ,  PO  AM  ( 1 0  0  > 
DIMENSION  PSAM  (100)  ,  FWFR  ( 1 0  0)  ,  D  WFR  ( 1  00  )  ,ZLWF  (1 C  0  ) ,  VWFF<  ( lu  J  I 

DATA  PR0GRM/6HSPRVS  /  .JF/100/ 

8015  FORMAT (  lHf,  102X,  8PAIR80RNE) 

8T16  FORMAT (  1H  ,  14,  8E12.4) 
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8017  FORMAT !  1H  3 , 5X  »  86H* 
1SE  VERTICAL  WINO  IS 

8019  FORMAT!  1H+,  102X, 

8020  FORMAT!  1H  +  ,  1J2X, 

8021  FORMAT!  1H0.  36X,  2 

8022  FORMAT!  23X,  9HFA 

1  7H  METERS/  23X,  3 

2  7H  METERS) 

8024  FORMAT!  2X,  4HNSEQ 
1  OX  ,  4HPMAS,  8X,  4H 

8025  FORMAT!  1H1,  38X,  3 


,  86H*  *  *  *  *  SHORT-CUT  TRANSPOR 
INO  IS  NON-ZERO  *  *  *  *  *//) 

10ZX,  9H  IMPACTEC) 

1 J2X,  17HOUTSIOE  WINDSPACE) 

36X,  2 1HPARTICLE  DIAMETER  IS  E12. 

9HFALL  RATEE12.5, 23H  METERS/SEC 
23X,  3 7HUPPER  LIMIT  ALTITUDE  FOP, 


4HNSEQ  ♦  6X,  2HXP,  1QX,  2HYP,  1U 
ex,  4HRWAF,  8 X ,  4HZLOW,  8X,  4HDWA 
38X,  3 1HPRE- TRANSPORT  PARCEL  FRCP 


VERTICAL  TURBULENCE 


SIGW=5.39MHAV)**!l.0/3.n) 


WRITE <IS OUT ,8025) 


COMPUTE  TURBULENCE  PARAMETER  AVERAGED  OVER  ALL  SPACE . 
HAV  =  0 . 

DO  40  L  =1,  LTI M X 
40  HA V  =HAV  *  HDAV  ID 
HAV  =HA V/LTIMX 

CHOOSE  STANDARD  DEVIATION  OF  VERTICAL  TURBULENCE 
SIGW=EDDY 

IF i MC !6 )  .GT.  0)  SIGW=5. 39* !HAV> **!l. 0/3.0) 
MC3=MC!  3) 

IF ( MC3  .GT.  0)  WRITE <IS OUT .8325) 

NSEQ=G 

PSZBE=-2.0 

IF ( MC (  4  l.NE.O)  GO  10  47 

CANCEL  SHORT-CUT  TRANSPORT  IF  VERTICAL  WIND  IS  NON-Z 
DO  45  L=1,LTIMX 
DO  45  K=i,KBHX 

IFiWAVG (K,L)»NE*  C. 0)GO  TO  46 

45  CONTINUE 
GO  TO  47 

46  MC!  4  )=1 
WRITEdS  OUT, 8017) 

47  CONTINUE 

CCMPUTE  OVERALL  AVERAGE  VERTICAL  VELOCITY 
KBHM1=KBHX-1 
WA VGK  =  0 <  0 
00  51  L=l, LTIMX 
DO  50  K=l, KBHM1 

50  WAVGK=W AVGK  *•  WAVG(K.L)*  (Z3HJK  +  1)  -  ZBH  { K>  ) 

51  WAVGK  =  WAVGK  *■  W  AV  G  (KBHX  ,  L  )  ♦  !  Z  MAX  -  ZBHIKBHX) 

W AVGK=W  AVGK/  !  LTI  MX"  'ZMINH 

CCMPUTE  TIMEX  MARGIN  FACTOR  FOR  AIRBORNE  TEST 
IF { ND AT  X-i)  70,70,60 
60  SLOP=l.l 
GO  TO  100 
70  SLO P=i. 0 

COPY  IN  PARCEL  BLOCK  COUNT 
IOC  REAO! JPARN) NP 

IFINP.LE.O)  GO  TO  806 

IF  !NP.GT.JF)  CALL  E R FOR ( FROGRM, - 10 0 ,  I SOUT) 

COPY  IN  A  BLOCK  OF  INPUT  PARCEL  PARAMETERS 

READ! JPARN)  ! XPAR! J) .YPARi J) , Z PAR ( J ) , TP AR 1 J ) , 

1RWFR ! J) , OHFR!J),ZLWF(J)vVWFR(J) ,J=1,NP) 
COMMENCE  PROCESSING  BLOCK  CF  INPUT  PARCELS  ONE  AT  A 
00  1000  J=1,NP 
NSEQ=NSEQ»1 

IF! NSEQ.LT • NSEQO)  GC  TO  1000 
XP^XPAR 1J) 

YP=YPAR  (J) 


T  IS  CANCELLED  BECAUSPRVS  47 

SPRVS  48 
SPRVS  49 
SPRVS  50 

5,  7H  METERS)  SPRVS  51 

AT  ALTITUDEE12.5,  SPRVS  52 

IMPACTION  ISE12.5,  SPRVS  53 

SPRVS  54 

,  2HZP,  10X,  2HTP,  SPRVS  55 

F/>  SPRVS  56 

ERTIES/)  SPRVS  57 

SPRVS  58 

,  HAV  SPRVS  59 

SPRVS  60 
SPRVS  61 
SPRVS  62 
SPRVS  63 
SPRVS  64 
SPRVS  65 
SPRVS  66 
SPRVS  67 
SPRVS  66 
SPRVS  69 
SPRVS  70 
SPRVS  71 

ERO  SPRVS  72 

SPRVS  73 
SPRVS  74 
SPRVS  75 
SPRVS  76 
SPRVS  77 
SPRVS  78 
SPRVS  79 
SPRVS  80 
SPRVS  81 
SPRVS  82 
SPRVS  03 
SPRVS  o 4 
SPRVS  65 
SPRVS  86 

>  SPRVS  a 7 

SPRVS  68 
SPRVS  89 
SPRVS  30 
SPRVS  91 
SPRVS  92 
SPRVS  93 
SPRVS  94 
SPRVS  95 
SPRVS  96 
SPRVS  97 
SPRVS  98 

PC  AM  < J ) »PS AM ! J  ) ,  SPRVS  99 

SPRVS1J0 

TIME  SPRVSlIi 

SPRVS1J2 
SPRVS1 3  3 
SPRVS 1 J  4 
SPRVS 10 5 
SPRVSl  ,6 


PC  AM  < J ) »PS AM  !  J  ) , 


iHSHvSasErf  nasra: 


iv.  GTr  SEH  >  ~2 
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ZP=ZPAR (J) 

TP=TPAR (J) 

PSIZ=PDAM(J) 

PMAS=PSAM(J) 

RWAF=RWFR( J)/2. 

DWAF=OWFR(J> 

ZLOW=ZL  WF(  J ) 

VWAF=VWFR< J) 

CHECK  FOR  NEW  PARTICLE  SIZE  CLASS 

IF(ABS( (PSIZ-PSZBE)/FSIZ) .LE.l.QE-iG)  GO  TO  103 
IF  (  MC3  .GT.  0)  WRITEdSCUT  ,8021)  PSIZ 
COMPUTE  MID-ATMOSPHERE  FALL  RATE  FA  1/  FOR  NEW  PARTICLE  SIZE  CLASS 
H=(ZMIN*ZMAX)/2. 

CALL  TRPL(H,NAT,ALT,ATP,T) 

CALL  TRPL< H, NAT , ALT  ,FRS»P) 

CALL  TRPL< H,NAT,ALT,RHO,DEN> 

CALL  TRPUH, NAT, ALT,  ETA, VIS) 

CALL  SETTLE! PS IZ,RH OF, OEN,VIS»T»P»FAV» IACCR) 

FAV=FAV-WAVGK 

COMPUTE  TABLE  OF  PARTICLE  SETTLING  SPEEDS  -  AN  ENTRY  FCR  EACH  STRATUM 
DO  101  KKZ=i,KBHX 
CALL  TRPL! ZCH (KKZ)  •  FAT,  ALT,  ATP*  T) 

CALL  TRPL(ZCH(KKZ5 ,  N  AT,  ALT  ,  PRS  ,  P> 

CALL  TRPL ( ZCH ( KK Z * , N AT, ALT , RHO , DEN) 

CALL  TRPL ( ZCH ( KKZ)  , N AT, AL T ,ETA , VIS ) 

1C1  CALL  SETTLE(PSIZ,RHOF,C£N,VIf,T,P,CAVS(KKZ) ,IACCR) 

COMPUTE  INITIAL  ALT.TTUOE  FCR  THIS  PARTICLE  SIZE  ABOVE  WHICH  DEPOSITION 
CANNOT  OCCUR 
TMAX=  TP 

DO  1001  IZ*i» KflHMl 

TMAX=TM  AX  +  (ZBH(IZ  +  1)  -  ZBH  <IZ  > )  /  <GAV  S  ( IZ>  -  WAVGK) 

IF(T M AX. GT. SLOP* TIMEX  .OR.  TM AX  .LT.  0.0  )  GO  TO  1002 
1001  CONTINUE 

TMA  X=TMA  X  ♦  <ZMAX  -  Z8H (KBHX) )/ !CA VS CKBHX)  -  WAVGK) 

ZLI M=  5. 0E4 

IF(TMAX,GT .SL OP* TIMEX  .OR.  TMAX  .LT.  d.O  )  ZLIM-ZMAX 
GO  TO  1012 
100  <  ZLIM-ZBHdZ  +  1) 

1012  IF( T  FAX  .LT.  0.0)  TMAX=TIMEX 

1003  ir(  MC3  .LT.  1)  GO  TC  1004 
WRITE  (IS OUT ,ti  0  22)  FAV,H,ZLIM 
WRITE 1 1  SOU  T, fe  0  24) 

1004  CONTINUE 

I F ( MO (  4  ) .NE. 0)  GO  TO  1255 

COMPUTE  DEPOSITION  TIME  FROM  THE  BASE  OF  EACH  STRATUM  FOR  USE  BY  THE 
C  SHORT-CUT  TRANSPORT  METHOD 

TSUM ( 1) =0. 0 
OO  1250  K=2, KBHX 

1250  T3UM(K)=T3UM(K-1)  +  (ZtlH(K)  -  Z  BH  C  K-  1 )  ) /CAVS  (  K-l ) 

1255  CONTINUE 

COMPUTE  CROSSING-TRAJECTORIES  OIFFUSIVITY  CORRECTIONS  FOR  NEW  PARTICLE 
C  SIZE  CLASS. 

OOWN= (FAV*EljY/SIGW)**2 
CROSS =1 ./SORT (1« *4. *COWN) 

OOWN=l. /SORT ( 1 • +OOW  N ) 

PSZBE=PSIZ 
1C  3  IF (  MC3  .GT.  0) 

1WRITE(ISOUT  ,8  016)  NSEQ , XP , YP, ZP , TP ,PMA S , RWAF ,Z LC W,  OWAF 
CANCEL  PROCESSING  OF  PARCEL  IF  IT  HAS  ALREAOY  IMPACTED 
IF  (IFIX(OWAF) .GT. 0)  GO  TO  1200 


SPRVS107 

SPRVS108 

SPRVS109 

SPRVS110 

SPRVS111 

SPRVS112 

SPRVS113 

SPRVS114 

SPRVSH5 

SPRVS116 

SPRVS117 

SPRVS118 

SPRVS119 

SPRVS120 

SPRVS121 

SPRVS122 

SPRVS123 

SPRVS124 

SPRVS125 

SPRVS1.26 

SPRVS127 

SPRVS128 

SPRVS129 

SPRVS130 

SPRVS131 

SPRVS132 

SPRVS133 

SPRVSl 34 

SPRVS135 

SPRVS136 

SPRVS137 

SPRVS138 

SPRVS139 

SPRVS140 

SPRVS141 

SPRVS142 

SPRVS1 43 

SPRVS144 

SPRVS145 

SPRVS1 46 

SPRVS1 47 

SPRVS148 

SPRVSl 49 

SPRVS1 50 

SPRVSl 51 

SPRVSl 52 

S»RVS153 

SPRVSl 54 

SPRVSl 55 

SPRVSl 56 

SPRVS157 

SPRVSl 58 

SPRVS159 

SPRVS160 

SPRVS161 

SPRVS162 

SPRVS163 

SPRVS164 

SPRVS165 

SPRVS166 
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IF (  MC3  .GT.  0)  WRITE(IS0UT *  8 J 1 9 ) 

CALL  DUMPERtXF.YP.ZP.TP,  RHAF,  RWAF,  PMA  S ,  FS I Z ,  0.  ,  Q, 

1ISOUT, IPOUT, MC3> 

GO  TO  1.000 

COMPUTE  INDEX  OF  MF.SH  OR  SUB-MESH  CONTAINING  PARCEL  CENTER 
1200  CALL  NEST  ( NET , NE  TSU ,  >P, YP, NOATP*  XL, XR, YL , YU » ICF , JCF, NCF) 

CANCEL  PROCESSING  OF  PARCEL  IF  IT  IS  INPUT  OUTSIDE  ATMOS. 

IF ( NOATP.GT • 0)  GO  TO  1260 

IF (  MC3  .GT.  0)  WRITEdS(UT»3320) 

GO  TO  1000 

CANCEL  PROCESSING  OF  PARCEL  IF  IT  CANNOT  REACH  THE  GROUND  IN  THE  ALLOT 
C  TIME 

1260  IFCZLOW.LT. ZLIM)  GO  10  1409 

IF  C  MC3  .GT.  0)  WRITEdSCUT  ,3015) 

GO  TO  1000 

140  9  CALL  ADVEG(NET,NETSU,Z6H,  TIMUP  ,USUM,VSUM  ,DXSUM ,DYSUN , RSUM, 

1WFZ,TSUM,CAVS,ZCH,ALT,ATP,PRS,RHC,ETA,TMAX, 

2 ICF, JCF.NCF.KBHF, NCATF.LT IMF,  NATF) 

1000  CONTINUE 
GO  TO  100 

COPY  OUT  BUFFER  DATA  VECTORS  FCR  DRY  OF-POSJT  INCREMENTS,  WAFER 
C  PROCESSING  HAS  BEEN  COMPLETED 

806  CALL  OUMPER<Q..J«, 0 . . 0 . .  J..  0.,  0.,  u.,d.*999. 


1ISOUT,IPOUT,MC3> 

CALL  DUMPER(0.t0. , C. *0. » 

1ISOUT .IPOUT , MC3  > 

REWIND  JPARN 
ENOFILE  IPOUT 
REWIND  IPOUT 
RETURN 
END 


w  .  I 


0., 
3 . » 


0  . , 
Cl. , 


C.,0.,999, 


SPRVS167 
SPRVS168 
SPRVS169 
SPRVSliTO 
SPRVS171 
SPRVS172 
SPRVS173 
SPRVS174 
SPRVS175 
SPRVS176 
EDSPRVS177 
SPRVS178 
SPRVS179 
SPRVS180 
SPRVS181 
SPRVS132 
SPRVS183 
SPRVS184 
SPRVS1*5 
SPRVS136 
SPRVSld  7 
SPRVS188 
SPRVS189 
SPRVS1J0 
SPRVS191 
SPRVS192 
SPRVS193 
SPRVS194 
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*QECK*  SUMDAT  SUMDA 

SUBROUTINE  SUMDA  T  ( N ET  ,N E  TSU  ,  Z3H  ,  ZCH ,  WA  VG, HD  AV,  USUM  ,  V  SU M,  KS UM,  WFZ  ,  SUMDA 
1 TIMUP, DXSUM, OY SUM, ICF,JCF,NCF,K8HF, NDA TF, LTIMF )  SUMDA 

SUMOA 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  SUMOA 

SUMOA 

***«>»*  «**«#**«  +  *#♦**•**  **#  4'  *  ***#*¥**#■»*♦♦****.<,♦***¥**  **S|jMDA 

SUMOA 

SUMS  ANO  WEIGHTS  WINC  ANO  TURBULENCE  DATA  FROM  ZMN  TO  ZBH(KBHX)  SUMOA 
FOR  USE  BY  THE  FAST  TRANSPORT  CALCULATIONS  SUMOA 

SUMOA 

AREA  -  AREA  OF  HORIZ.  SPACE  NET  SUMDA 

AREAN  -  AREA  OF  A  PARTICULAR  MESH  SUMOA 

SUMOA 

+  «***¥  +  *+**  #¥*#*♦****¥•***♦¥*##*****♦  -V  SUMDA 

SUMDA 

COMMON  /CNTROL/  IPO U T , IS  IN, I  SOU T , JP ARN , MC ( 20 ) » NSEQO  SUMDA 

COMMON  /INDEX/  ICX  ,  JCX , K8HX f LT If X , N AT  ,NCX , NDA TX  SUMOA 

COMMON  /SPACE/  MINT  ,XLLC, YLLC.ZMAX ,ZMI N, TIMEX  SUMOA 

C  SUMOA 

OIMENSION  RSUM (KBHF  ,NOAT F, LTIMF ) ,HDAV(lTIMF) ,H A V G ( KBHF, L TI MF)  SUMOA 

DIMENSION  NET <ICF,JCF),NETSU<NCF>, ZCH (KBHF) , TIMLP( LTIMF)  , Z3H (K EH F) SU MO  A 
OIMENSION  OXSUM<KBHF,NDATF, LTIMF), DY SUM < KBHF ,N DA TF , LTIMF )  SUMDA 

DIMENSION  USUM(K8HF ,NDATF, LTIMF) ,V SUM < KBHF , NDA TF  , LTIMF)  SUMOA 

OIMENSION  WFZ(KBHF,  NOATF',  LTIMF)  SUMDA 

C  SUMDA 

1  FORMAT < 1H0 1  5X,  1 7FUPOATE  TIME  INDEXI3,  23H.  WINO  GRID  CELL  INSUMOA 

10EXIJ,  38H  WITH  HORIZONTAL  COORDINATES  (X,Y>  -  (E12.5,  1H,,  E12.5,sUMDA 

2  8H)  METERS/)  SUMDA 

2  FORMAT (  9X,  5HLAYER,  «X  ,  lOHHORIZONTAL »  6Xf  1 OPHORIZONTAL,  SUMDA 

1  7X,  9HCR0SSWIN0  ,  7X,  8HD0WNWI NC ,6 X1C HHORI ZONTAL /  SUMOA 

2  8X  ,  6HCENTER,  8X,  1CHE.-W.  WIND,  6X,  1QHN.-S.  WIND,  2 <6X10 HTURBULSUMD A 

3ENCE),  6X,  8HR0TATICN/  8X,  8HALTITUDE,  A <7 X 9HC CMPONE NT ) ,  9X,  SUMOA 

4  5H ANGLE)  SUMOA 

6  FORMAT  ( 1H1 ,  40X,  21  H  t«EIGHTEO ,  SUMMED  OATA//)  SUMOA 

8  FORMAT  < /23X,  6 HUP  CAT  El  4,  6H  MESHI4 ,  32H  AVERAGE  TURBULENCE  P4SUMDA 

1RAMETER  =F12.5)  SUMDA 

9  F  ORMAT ( 1H1 ,  29X,  5  7HTHREE  DIMENSIONAL  WIND  ANU  TURBULENCE  OATA  B£cSUMOA 

1  ORE  SUMMING/)  SUMOA 

12  FORMAT (  9 X ,  5HLAYER,  8X,  lOHHORIZONTAL,  6Xf  1 OHHORI 20NTAL ,  SUMOA 

1  7X ,  8H VERTICAL  t  8X  ,  9HC  FOSSWINO ,  7X,  8H00WNWI NC ,7X10 HHORIZONT AL/  SUMOA 

2  8X,  6HCENTER,  8X,  10HE.-W,  WIND,  6X,  10HN.-S.  WIND,  9X, 4HWIND, 3X, SUMDA 

3  2  <  6X ,  lOHTURBUL  ENCE) ,  7X,  8HR0TATI0N/  8X,  8HA  LTITUOE ,  ‘  SUMDA 

4  5  <  7X,  9HC0MP0NENT)  ,  9X,  5  MANGLE)  SUMDA 

13  FORMAT ( 6E16.4)  SJMDA 

14  FORMAT ( 7£1 6# 41  SUMOA 

15  FORMAT ( 1HO,  22X,  5  5HTURBULENCE  PARAMETER  AVERAGED  OVER  ALL  SPACE  SUMOA 

IFOR  UPDATE  14, 3 H  ISE12.5)  SUMDA 

16  FORMAT < 1H0, 22X 48  HA  V ERAGE  VERTICAL  WINO  CC  MP ONE  NT  FOR  EACK  LAYER  -> SUMOA 

17  FORMAT (  20X,  6CI5,  Ffi.3,  1H,)>  SUMOA 

C  SUMOA 

IF ( MC (2 )  .EQ.  1  .OR.  MC<1)  . EQ.  J>  GO  TO  2t  SUMDA 

COPY  OUT  THREE  OIMENSIGNAL  WINC  AND  TURBULENCE  DATA  BEFORE  SUMMING  SUMDA 

WRI TE (I SOUT ,9 )  SUMOA 

DO  50  L  =  i,  LTIMX  S'JMOA 

DO  51  N=l, NDATX  SUMOA 

CALL  CNTR(NET,NETSL,N,XG,YG,ICF,JCF,NCF)  SUMOA 

WRITECIS0UT,1)L,N,XG,YG  SUMDA 

WRI TE  < I  SOU  T, 1 2)  SUMOA 

00  50  K=l, K9HX  SUMDA 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 
19 
2  C 
21 
22 

23 

24 

25 

26 
27 
26 
29 
JO 

31 

32 

33 

34 

35 

36 

37 

38 

39 
AO 

41 

42 
h3 
44 
l5 

46 

47 

48 

49 

50 
5  1 

52 

53 

54 

55 

56 

57 

58 

59 

60 
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50  WRITE(IS0UT,14>  ZCH  ( K)  ,  US'JM  <  K ,  N,  L)  ,  V  SUM  ( K  ,  K ,  L  >  ,  WFZ  «K ,  N  ,  L  )  » 
i  OXSUM(K»N»L)  ,OYSUM  (K,  N,  L)  ,RSUM(K,N,L) 

ALCULATE  THE  WEIGHTED  SUMS  OVeR  ATMOS.  STRATA  AND  REWRITE  ARRAYS 
USUM,  V  SUM ,  RSUM,  DXSYM e  DYSUH.  ALSO  COMPUTE  HOAV  AND  WAVG. 

20  AREA=ICX*JCXMWINT**2> 

IF ( MC (2  )  rEQ.  2)  WRITEtl SOUT ,6) 

DO  922  L=i,LTIMX 
DO  1304  LK=1*  KBHX 
13C4  WAV G ( LK  »L) =0 • C 
HDAV(L) =0. 

DO  921  N=1 »  NO ATX 

IF  (  MG  ( 2  )  •  NE.  2)  GO  TO  915 

CALL  CNTR(NET,NETSU,N,XG,YG,ICF,JCF,NCF> 
WRITE(ISOUT,i)L,N,XG,YG 
WRITE ( I SOUT »2  l 
915  ZSTEP=ZBH( 2)-ZBH  <1> 

USD  M ( 1. N,L)=USUM(1,N,L)  *ZSTE» 

VSUM(l,N»L)=VSUM(i*N»L)*ZSTEP 

RSUM(i,N,L)=RSUM(i  ,N,L) *ZSTEP 

OXSUM(i»N»L)-OXSUM(l»N,L)*ZSTEP 

DYSUM(1,N, L)»DYSUMC1,N,L)  *ZSTEP 

HAV=  (OXSUMdtN*  L)  +  O YSUM ( 1 , N,L) ) / 2. 0 

KBHM1=K  BHX-1 

DO  920  K=  2»KBHM  1 

ZSTEP=ZBH(K+i)  -  ZBH (K) 

USU  M ( K , N , L ) =USUM (K , N  ,L) *ZSTEP  ♦  USUM (K-l, N, L> 

VSUM ( K»  N,L ) =VSUM (K ,  N ,L) * ZSTEP  *  VSUM (K-l, N, L) 

RSU  M( K,N,L)=RSUM(K,N,L) *ZSTEP  +  RSUM (K-l  ,N,L ) 
HAV=HAVMOXSUM(K,N,L  )  ♦  OYSUM ( K , N, L)  ) * ZSTEP/2. 0 
DXSUM<K,N,L)=OXSUM(K,N,L)*ZSTEP  ♦  OX  SUM ( K-l , N, L > 

920  OYSUM(K,N,L)=DYSUII  < K  ,N ,L > *ZSTEP  ♦  OY  SU  M  (  K-l ,  N,  L  > 

HAV  =  (HAV  ♦  (DXSUM  (KBHX,N,U  4-0  YS'JM  ( KBHX , N,  L )  >  *  (ZMAX-ZBH  (KBHX) 
1  ) /(ZMAX-ZMIN) 

COPY  OUT  SUMMED  DATA  IF  RECUESTEO 
IF  (  MC  ( 2  )  •  EQ  .2 ) 

1  WRITE (I SOUT, 13 5 ( ZCH (K) , USUM(K, N, U , V SUM ( K , N , L)  ,OXSUM  <K,N,L* , 

2  OY  SUM ( K, N «  L) ,RSUM ( K  «N,L ) , K=1 , KBHX  > 

IF ( MC (2 )  .NE.  1  .AND.  MC(i)  .EQ.  1)  WRITE ( ISOUT, 8) L ,N, HAV 
CALL  CNTR(NET,NETSU,N,XG,YG ,ICF, JCF, NCF) 

XQ=  XG 
YQ=YG 

CALL  NEST(NET,NETSU,XQ,YQ,NDATQ,XL,XR,YL, YU, ICF, JCF, NCF) 

ARE AN= ( XR-XL) * (YU-YL) 

HOA V (L  )  =  HOAV(L)  +  HAV* A  PE AN 
DO  9210  KL= 1, KBHX 

9210  WAVG(KL,L>  =  W  AVG  (KL  ,  L)  4-  WFZ (KL , N, L ) *  ARE AN 

921  CONTINUE 

HDAVCl.)  =HD  A  V(  L  )  /  ARE  A 
OO  9215  KL  =  1 , K B N X 
9215  WAVG(iCL,L)  =  WAVG(KL,LI  /  AREA 

IF ( MC ( 2  )  .NE.  1»  WRITE(ISOUT,15) L,HDAV (L> 

IF (  MCC2)  .EQ.  1  .OR.  MC ( 1»  .EQ.  0)  GO  TO  922 
WRITE (ISOUT, 16) 

00  9922  KL  =  i, KBH X, 6 
KLP5  =  !<L  4-5 

9922  WRITE(ISOUT ,17)  (K,  WAVG(K,L),  K=KL»  KL  P5) 

922  CONTINUE 
RETURN 
ENO 
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*0EC  K»  TRANP  TRANP 

SUBROUTINE  TR ANP (NET ,NETSU , ZBH , T HUP , USUM , V SUM ,0XSUM , DYSUM , RSU F,  TRANP 
1WFZ,CAVS,TSUN,TMAX,XC,YQ,Z0,T0,SIGXQ,SIGY0,R0,  NCATO,  TRANP 

2 ICF ? JCF ,NCF, KBHF , NOATF  ,LTIMF>  TRANP 

TRANP 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  197 e  RANP 

iRANP 


TRANP 

GIVEN  COORDINATES  ANO  SETTLING  SPEEDS  FOR  A  FALLCUT  PARCEL  •  aUS  ATRANP 


TRANSPORT  TIME  LIMIT,  TRANP  COMPUTES  » HE  PARCEL  COORDINATES  AT  TRANP 
ITS  DEPOSITION  POINT  OR  AT  THE  POINT  IT  LEAVES  THE  WIND  SPACE  OR  TRANP 
AT  THE  POINT  WHEN  IT  RUNS  OUT  OF  TIME.  TRANP 

TRANP 
TRANP 

MODE  ~  COMPUTATION  MODE  SWITCH  TRANP 

0  RAPID  COMPUTATION  (ALL  THE  WAY  TO  DEPOSITION  USING  TRANP 
WEIGHTEC,  AVERAGED  WINDS)  TRANP 

1  LAYERWISE  COMPUTATION  TRANP 

TO  -  TIME  AFTER  PARCEL  ACVECTION  TRANP 

XO  -  PARCEL  CENTER  X  COORDINATE  AFTER  AO'.ECTICN  TRANP 

YO  -  PARCEL  CENTER  Y  COORDINATE  AFTER  AOVECTION  TRANP 

ZO  -  PARCEL  CENTER  Z  COORDINATE  AFTER  AD V EOT  I  ON  TRANP 

SIGXO  -  PARCEL  OOWNWINO  DISPERSION  PARAMETER  AFTER  AOVECTION  TRANP 

SIGYO  -  PARCEL  CROSSING  DISPERSION  PARAMETER  AFTER  AOVECTION  TRANP 

NDATO  -  INDEX  OF  HORIZONTAL  SPACE  RESOLUTION  NET  MESH  TRANP 

RO  -  WIND  HEAOING  ORIENTATION  ANGLE  AFTER  AOVECTION  TRANP 

TRANP 

*4  44  4444444  4444*4444444  ♦#**44.44»**44**4*4»fRANP 

TRANP 

COMMON  /CNTROL/  IPOU T, I  SIN, ISOUT , JPARN , MC < 2 0) » NS EQO  TRANP 

COMMON  /INDEX/  ICX , *CX , »BHX ,LTIMX ,NAT , NCX ,NOA TX  TRANP 

COMMON  /PAROL/  CRO S S,OOWN , 0 W AF , EDDY ,NC AT P , PMA S , FS IZ, RHOP, RWAF,  TRANP 

1  TP.XP, YP, ZLOW.ZP  TRANP 

COMMON  /SPACE/  MIN T , XLL C , YLLC , ZM AX , ZMI N  ,T I MEX  TRANP 

C  TRANP 

DIMENSION  NET (ICF, JCF) ,NETSU (N CF ) , ZB HC KBHF ) , US UM CKBHF , ND A T F, LTIMF)  TRANP 
DIMENSION  VSUMtKBHF,  tvDATF,  LTIMF)  ,DXSUM  CKBHF,  NO  ATF,  LTIMF)  TRANP 

DIMENSION  DYSUMCKBHF, NOATF, LTIMF), TIMUP(LTIMF> ,CAVS<K8HF)  TRANP 

DIMENSION  RSUH (KBHF, NOATF, LTIMF)  ,WFZ (KBHF , NDAT F , LT IMF )  ,TSUM ( KBHF )  TRANP 

C  TRANF 

OATA  PROGRM  ,  EPSILO  ,  EPSZ  ,  QBRT  ,  VAKL  TRANP 

1  /6HTRANP  ,  . 0 □ C  5  ,  0.1  ,.3333333333,  1.CE9  /  TRANP 

C  TRANP 

2  FORMAT (  6H  TIME=E12.4,  5H  ALT=E12.4,  7H  X-P0S=E12.4,  7H  Y-POS=E 12 TRANP 

1.4,  6 H  MESH  =  I4,  8F  REACHED)  TRANP 

3  FORMAT  (  6H  TIME=£12.4,  5H  ALT  =  E12.4,  7H  X-P0S=E12.4,  7H  Y-POS=E  12TRANP 

1.4,  6 H  MESH=I 4 ,  10H  ATTEMPTED)  TRANP 

4  FORMAT (  1H0.  38HPARCEL  AT  INITIAL  POINT  < XP , YP , ZP,TP)  4E12.4/  TRANP 

1  31H  REQUIREQ  CHANNELLING  AT  POINT  4E12.4)  TRANP 

C  TRANP 

EPS=EPSIL0*WINT  TRANP 

EPST=EPSILO*TMAX  TRANF 

XO=XP  TRANP 

YO=  YP  TRANP 

ZO=ZP  TRANP 

TO=  TP  TRANP 

S IGXO=  3 .  TRANP 

SIG Y0  =  0  .  TRANP 

RO=  0 .  TRANP 


1 

2 

3 

4 

5 

6 
7 
6 
9 

I'- 

l.l 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 
h3 

44 

45 

46 
1.7 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
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NDA  TO=N  DATP 

NOT  C1=0 

NDTOl=0 

K8HCi=9 

K8H0i=Q 

LTlH=i 

1000  CONTINUE 
MODE=-l 

IF ( MC (4 )  .N£.  0)  MOCE=MOOE+i 
50  MOOE=MOO£+i 

IF(LTIMX.GT.1)CALL  CALI 8  (TIHUP.LTIMX ,TO,l, LTIM 
CLOSEST  Z8H  PLANE  8ELOW  ZC,  OR  EQUAL  TO  ZO,  IS  FOUND 
CALL  CALIB(ZBH,K8HX,Z0,  J.KBHO) 

IF(Z0“Z8H(KBH0  >.GT.  EPSZ)  KBHO=KBHOU 
100  W3AR=-CAVS  (K8HO-1) 

IF(MCDE.EQ. 0)GO  TO  210 

CONSIDER  TRANSPORT  BETWEEN  AOJACENT  Z8H  PLANES 
W8AR=W8  AR+WFZ  C  KBHO- 1 »NOAT  O,  LTIM) 
IF(W8AR)2f)6,110,20& 

C  WHEN  NET  SETTLING  SPEED  IS  ZERO,  SET  THE  TIME 

C  TIME  LEFT  BEFORE  THE  NEXT  UPDATE. 

110  TSEG=TI MEX-TO 

IF <  L  TIM.LT.LTI MX) TSEG=TIMUP (LTIH  +  1) -TO 
K8HC=KBH0 
KBHO=KB  HC-1 
GO  TO  300 

CHECK  IF  K3H0  ADJUSTMENT  MLSY  BE  MAOL  BECAUSE  PARCEL 
206  IF(WBAR.LT.O.O.OR.AES(ZO-Z8H (KDHO)) .GT.EPSZ) IF 
KBHQ=K9  HO+1 
GO  TO  1L0 

ONCLUDE  KBHO, KBHC  SETTING  £  FOR  A  RISING  PARCEL 

KBHO( KBHC) IS  THE  ZBH  PLANE  FROM  WHICH  (TCWARU 
IS  MOVING. 

209  IF(ZO-ZBH(t<BHO)  .LT  .- EPSZ)  KBHO=KBHO-l 
210  K3HC=K3H0*IFIX (SIGN ( 1.0, WBAR) ) 

TSEG  =  (Z8H(K8HC) -ZO)/WBAR 
IFC-'OOE.NE.O  .OR.  A  8S<  ZO-Z  BH  (  K8HO)  ?  .GT.  EPSZ 
COMPUTE  OVERALL  SETTLING  TIME  ANO  AVERAGE  SETTLING  S 
TSEG=TSEG+T SUM (KBHC ) 

WBAR= (ZMIN-ZO)  /TSEG 
K8HC=  1 

300  TC=  T O+T  SEG 

CHECK  IF  A  TIHE  BOUNDARY  IS  CRCSSEO 

IF ( LTIM  .EQ.  LTIMX)  IF( TI M EX-TC ) 30 1, 35 l , 3 50 
IF(TIMUP(LTIM«-D-  TC)  30  5,350,350 
CHANGE  PARAMETERS  TO  LIMIT  TRANSPORT  TC  OR  LESS  THAN 
301  TSEG=TI MEX-TO 
TLIM=TI MEX 
GO  TO  306 

305  TSEG  =  TIMUP(LT  IM<- 1)  -TO 
T  L I  M = T I MUP (LTI M  + 1 ) 

306  IF ( M  COE  .GT.  0  .OR.  KBHO-KBHC  .EQ.l)  GO  TO  3 
CALL  CALI8(TSUM,KBHX,TC-TLIM,-1,K3HC) 

IF( KBHO  .GT.  KBHC)  GC  TO  310 

KBHC=K3HC-1 

WBAR= -C AVS (KBHC) 

GO  TO  350 

310  TSEG  =  TSUM (KBHO)  -  TSUM(KBHC) 

W8AR= (ZBH (KBHC)- ZO) /TSEG 

COMPUTE  AVERAGE  HORIZONTAL  VELOCITIES  UBAR  ANO  VBAF. 


INCREMENT 


IS  RISING 
(WeAR)  210,210 


WHICH)  THE  PARCEL 


)  GO  TO  300 
PEED  FROM  ZO 


TRANP  61 
TRANP  62 
TRANP  63 
TRANP  64 
TRANP  05 
TRANP  66 
TRANP  67 
TRANP  68 
TRANP  69 
TRANP  70 
TRANP  71 
TRANP  72 
TRANP  73 
TRANP  74 
TRANP  75 
TRANP  76 
TRANP  77 
TRANP  78 
TRANP  79 
THE  TRANP  80 
TRANP  81 
TRANP  82 
TRANP  33 
TRANP  34 
TRANP  85 
TRANP  86 
TRANP  67 
,209  TRANP  o 8 
TRANP  89 
TRANP  9 C 
TRANP  91 
RCEL  TRANP  92 
TRANP  93 
TRANP  94 
TRANP  95 
TRANP  96 
TRANP  97 
TO  ZMINTRANP  98 
TRANP  99 
TRANP10  3 
TRANP101 
TRANPliiZ 
TRANP10  3 
TRANP1'4 
TRANPlo 5 
BOUNDARY  TRANP1G6 
TR ANP13  7 
TRANP1J8 
TRANP 10 9 
TRANPliO 
TRANPlll 
T  RaNP 112 
TRANP 113 
TRANPll*. 
TRANP115 
TRANP116 
1 KANP117 
7RANP118 
TRANP119 
TRANP120 
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350  KBHA=K8H0 
KBHB=KBHC 

IF ( WBAR»LT *0*0)  GO  TO  405 

KBH A=KBHO 

KBHB=KBHO 

405  CALL  GETOA (  USUM , ZBP ,KB HA, KBHB , NDATO , LT IM, 
CALL  GE TOA (  VSUM,ZBH  ,K3HA, KBKB, NDATO ,LTIK, 
407  CONTINUE 


UBAfi.KBHF, NDATF  »LTIMF ) 
VBA  R  »  K8HF  jNDA  TF  tLTIMF ) 


COMPUTE  AVERAGE  HORIZONTAL 


VERSION 


ORIENTATION  ANGLE 


CALL  GETQA (OXSUH, Z9H  ,K8H A, KBHB , NDATO ,LTIM, DX6A R , K3HF, NDATF tLTlMF) 
CALL  GETOA(DYSUM,ZBH«KBHA, KBHB , NOA TO , LT IM, DYQA R , K8HF , NDATF , LTIMF  > 
CALL  GETOA (  RSUM , ZBH  ,K8HA, KBHB , NDATO , LT IM,  RBA R , KBHF, NDATF , LTI MF ) 
RC=RO+RBAR 

SIGXC=SIGXO-*-DXBAR*TSEG 
SIGYC=SIGYO+OYBAR*TS  EG 

COMPUTE  CURRENT  POSITION  AND  TIME  (  XC  ,  YD  ,  ZC  ,  T  C ) 

TC=TO+T  SEG 
ZC=ZO+WBAR*TSEG 
XC=XO+UBAR*TSEG 
YC=YO+VBAR*TSEG 

CALL  NESTINET,NETSU,XC, YC.NOATC, XL.XR, YL, YU, ICF, JCF.NCF) 

IF  (  MC  ( 5  )  ,  EQ  « 1 )  HR  ITE  (I  SOL'T  ,  3)  TC , ZC , XC , YC , NO AT C 
COMPARE  CURRENT  MESH  INDEX  NDATC  WITH  PREVIOUS  MESH  INDEX  NDATO 
IF(NDATC.EQ. NDATO!  GC  TO  70 0 
IF  (MODE.EQ.G)  GO  TC  50 
COMPUTE  INTERPOLATED  POINT 
XT=XC 
YT=YC 
ZT  =  ZC 

CALL  BOUN< NET, NETSU, XT, Y 1, XO, YO , XC, YC , ICF, JCF,  NCF) 

ZC=  SORT < (( XT-XC) **2  +  (YT-YC) ♦♦2) /( (XT-XO)  **2  +  (YT-YO  2 > > 

zc=ZT*zc*<zo-zn 

IFCABSl WBAR) ,LE. l.QE-30!  GO  TO  510 

TSEG=(ZC>*ZO)/HBAR 

GO  TO  518 

510  IF(ABSIUBAR) ,LE. l.QE-30)  GO  TO  523 
TSEG=(XC-X0)/U8AR 
GO  TO  518 

513  IF(A8S<VBAR)*LE.i. QE-3Q)  GO  TO  516 
TSEG=(YC-YO)/VBAR 
GO  TO  518 

516  CALL  ERRQRCPROGRM, 516, IS  CUT) 

RETURN 

516  CONTINUE 
RC=  RO+RBAR 

SIGXC=SIGXO*OXBAR*TSEG 
SIGYC  =  SIGYO+’OY3AR*TSEG 
521  TC=TO*-TSEG 

CALL  NESTCNET,HETSL‘,XC,YC,NOAi  C,XL,XR,YL,YU,ICF,  JCF,  NCF) 

CHECK  IF  PARCEL  CFNTER  POSITION  IS  OoCILLATING 

IF ( (KBHOl.NE.KBHO) .  CR  .  < K8HC1. NE . K3HC ) .OR, ( NDTC 1 . NE. NDATC ) .  OR. 

1  (NDTOl.NE.  NDATO!)  GO  TO  62b 
IF ( MC ( 5 ) . EQ • 1 >  WRI TE  I ISOUT ,4)  XP  ,  YP , ZP , TF , XC , V C  ,  ZC , TC 
CALL  CNTR(NET • NETSU, FOATO.XG.YG, ICF, JCF, NCF) 

XQ=  XG 
YQ=  YG 

CALL  NESKNtT, NETSU, XC,  T  Q,  NOATQ ,  XLO,  XRO  ,  YLO,  YUO ,  IC  F,  JCF ,  NCF ) 
CLEAR  STORED  MESH  AND  STRATUM  INDICES 
NDTCi=0 
NOT  01  =  3 


TRANP121 
TRANP122 
TRANP123 
TRANP124 
TRANP125 
TRANP126 
TRANP127 
TRANP128 
TRANP129 
TRANP130 
TRANP131 
TRANP132 
TRANP133 
TRANP134 
TRANP135 
TRANP136 
TRAN PI  3 7 
TRANP138 
T  RANP139 
TRANP140 
TRANPlAl 
TRANP142 
TRANPI, 3 
TR4NP144 
TRANP145 
TRANP146 
TRANP147 
TRANPUe 
TRANP1A9 
TRANP150 
TRANP151 
TRANP1S2 
TRANP153 
TRANP154 
TRANP155 
TRANP156 
TRANP157 
TRANP158 
TR AN  P 1 59 
TRANP1 60 
T  R  ANP 161 
TRANP162 
TRANP163 
TRANP164 
TRANP165 
TRANP166 
TRANP167 
TRANP168 
TR ANF 169 
TRANP170 
TRANP171 
TRANP172 
TR ANP 1 73 
TRANP17L 
TRANP175 
TRANPi 76 
TRANP177 
TRANP178 
TRANPI 79 
T  RANP131) 


K3HC1=0 

K8HOi=0 

CHANNEL  WAFER  CENTER  POSITION  ALONG  APPRPRIATE  CELL  BOUNDARY 
S?E=2.mEPS 

IF(  <AbS(XLO-XR»  .GT.SPE)  .  AND,  (ABStXRO-XL)  .GT.SPE))  GO  TO  61* 

UB AR= 0 • 

CALL  GETOA {  VSUM  ,ZBH»KBHA» K6HB* NCA TO , LTI K, VBARC . KBHF , NOA TF , LTIHF ) 
IFCABSt VBARC) .LE.ABS(YBA F> )  GO  TO  4Q 7 
V  3  A  R=  VB  ARC 
NOATO=NOATC 
GO  TO  407 

616  IF C (ABS  <YLO-YU> .GT.SPE) . AND. < A3S ( YUO-YL > .GT . SP E  > ) 

1  CALL  ERRORCPROGRM,ei6fISOUT> 

VS£ R=C. 

CALL  GETOA  (  USUM  ,ZB P  .KBH  A  ,  KBH3  ,  NO ATO  ,  LT  IK,  UBaR C ,  KBHF ,  NDA  TF ,  LTIMF  > 
IF  <  ABS  <  UBARC)  .LE.ABSCUBAR)  )  GO  TO  aC  7 
UBAR=UB  ARC 
NOATD=NOATC 
GO  TO  407 
COMMIT  PREVIOUS  <■ 

626  NOT  Cl  =  NO AT 
NDTOlaNOATG 
KBHCl=K8HC 
K3H0i=KBH0 

CCNVERT  XO.YO.ZO.TO, SI GXO, SIGYC. 

700 


URRENT  MESH  ANQ  STRATUM  INDICES  TC  STORAGE 


ANO  NOATO  TO  CURRENT  VALUES 


WRI TE (ISOUT  t  2)  TO,ZO,XO,YOvNDATO 


ATMOSPHERE 


ZO=ZC 

xo-xc 

YO=YC 
TO  =  TC 

NOA  TO  =  NDATC 
IF(MCJ5) -EQ.i) 

SIGXO-SIGXC 
SIGYO- SIGYC 
RO=RC 

CHECK  IF  CURRENT  POSITION  IS  OUTSIOE 
700  IF ( NO AT  O  »LE  «  0 )  GO  TC  72(3 
C  IF  OPPOSITION  PLANE  IS  REACHED  OR 

C  EXIT  FROH  TRANP,  OTHERWISE  RETURN 

IF  ((  LZO-ZMIN)  .LE.EPSZ)  .  OR.  ( 

GO  TO  1000 

COMPUTF.  HORIZ.  OISPERSION 
720  R2  =  P.WAF**2 
TRIP-TO-TP 
OSPRTX=SIGXO/TRIP 

SIGXO  =  (  R2+*Q8RT  ♦  2.0  *  OGWN  * 
IF (  SIGXO  .GT.  VAfiL  )  SIGXO  = 

1  (  DSPRTX/  VARL  >  •**QBRT  ♦  3.0  * 

SIGXO  =  SORT (  SIGXO  ) 

OSPRT Y  =  SIGYO/TRI F 

SI5Y0  =  (  R2**QBRT  *  2.0  *  CROSS 

I F <  SIGYO  .GT.  VARL  >  SIGYO  = 

1  (  OSPRTY/  VARL  )  **GBRT  *■  3.U  * 

SIGYO  -  SQRTI  SIGYO  ) 

RETURN 

LNO 


TRANSPORT  TIME  LIMIT  IS 
TO  TOP 

(TIMEX-TO)  .LE.EPST)  >  GO  TO  720 


TRANP1S1 
TRANP192 
TRmNP19  3 
TRANP10S 
TRANP185 
TRANP186 
TRANP137 
TRANP18  j 
TRANP189 
TRANP130 
TRANP191 
TRANP192 
TRANF193 
TRANP  134 
TRANP 13 5 
T  RANP196 
TRANP1S7 
TRANP198 
TRANP139 
7RANP2J0 
TRANP2G1 
TRANP2J2 
TRANP2 33 
TRANP2J4 
TRANP2C5 
TRANP236 
TRANP 2  -  7 
TRANP2J8 
TRANP2 39 
TRANP21C 
TRANP211 
TRANP212 
TRANP213 
TRANP214 
TRANP215 
TRANP216 
EXCEED  EC TRANP 21 7 
TRANP218 


TRIP  *  OSPRT  X**QBP,T/3.  V  )  **  3 
VARL  *  <  2.0*  OORN  *  TRIP  * 

!  R2/  VARL  )  **QBRT  -  2.  i'  ) 


TRIP 
VARL 
!  R2/ 


*  DSFRTY**GBRT/3.0  )  »♦  3 

*  (  2,  0  *  CROSS  *  TRIP  * 
VARL  )**QBRT  -  2,3  > 


TRANP  219 
TRANP220 
TRANP221 
TRANP222 
TRANP223 
TRANP 224 
TRANP225 
TRANP226 
TRANP227 
TRANF228 
TRAN? 229 
TRANP230 
TRANP231 
TRANP232 
TRANP233 
TRANP234 
TRAMF235 
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♦DECK,  TRIOIN 

SUBROUTINE  TRIDI N( NET.NE TSU , ZCH , VX 
1KBHF.NO ATE, LTIMF,  FORM,  SPEC) 


V  Y 


C 

c 

c 

c 

0 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


TRIDI 

VZ  .LTIM.ICF, JCF.NCF.  TRIDI 

TRIDI 
TRIDI 
TRIDI 
TRIDI 

***¥**********♦*»¥♦♦##*¥■*¥*¥****•**♦*»***¥**•******¥  *#¥♦*¥♦  ¥¥¥¥¥¥¥¥¥*¥¥*  TRIO  I 

TRIDI 

THIS  SUBROUTINE  FORMS  A  HORIZONTALLY  AND  VERTICALLY  VARIANT 


H.  G.  NORHENT,  ATMCSFHER IC  SCIENCE  ASSOCIATES  -  DECEMBER  1976 


WIND 


OR  TURBULENCE  FIELO. 


ALPHA 

BETA 

FMT 

NN 


A  WEIGHTING 
A  WEIGHTING 
OBJECT  TIME 
THE  NUMBER 


INPUTS  ARE  - 
FACTOR  FOR  THE 
FACTOR  FOR  THE 
FORMAT 

OF  NEAREST  DATA 


VERTICAL  DISTANCES 
HORIZONTAL  DISTANCES 

VECTORS  THAT  THE  USER 


TRIDI 
TRIDI 
TRIDI 
TRIDI 
TRIDI 
WISHESTRIDI 
TRIDI 


i  ETC 


BIG 

DM 

GI3 
JTOPV 
NAD  CJ) 

NAOT 

XG.YG.ZG 


TO  BE  USEC  IN  COMPUTATIONS 
INPUT  DATA  POINTERS  TRIDI 

FACTORS  USED  TO  TRANSLATE  AND  SCALE  THE  INPUT  DATA  TRIDI 

HEIGHT  OF  THE  J-TH  VRCTOR  TRIOI 

WEST-EAST  COORDINATE  OF  THE  J-TH  VECTOR  TRIDI 

SOUTH-NORTH  COORDINATE  OF  THE  J-TH  VECTOR  TRIDI 

EASTWARD  POINTING  COMPONENT  OF  THE  J-TH  VECTOR  TRIDI 

NORTHWAFO  POINTING  COMPONENT  OF  THE  J-TH  VECTOR  TRIOI 

UPWARD  POINTING  COMPONENT  OF  THE  J-TH  VECTOR  TRIDI 

READING  OPERATION  IS  TERMINATED  WHEN  ZS < J ) .GE.9 99999.  TRIDI 

TRIDI 

*#*##*****»*¥**-**¥'»-4mm.***TRIDI 

TRIDI 

AN  ARBITRARILY  LARGE  NUMBER  TRIDI 

DISTANCE  BETWEEN  THE  CURRENT  GKIO  POINT  AND  THE  MOST  TRIDI 
REMOTE  OF  THE  NEAREST  NN  DATA  POINTS  TRIDI 

AN  ARBITRARILY  SMALL  NUMBER  TRIDI 

THE  TOTAL  NUMBER  OF  HIND  DATA  POINTS  BEING  USED  TRIOI 

IND ICES  CF  DISTANCES  BETWEEN  THE  CURRENT  GRID  POINT  TRIOI 
AND  THE  JTH  DATA  POINT  TRIDI 

INDEX  OF  THE  NAD  THAT  CONTAINS  THE  ACCRESS  OF  THE  D2  TRIDI 
WHICH  IS  THE  LARGEST  OF  NEAREST  NN  DATA  POINTS  TRIDI 

COORDINATES  OF  A  SPACE  LATTICE  CENTER  POINT  TRIDI 


Nit  N  2. 
SCALE 
ZS(  J) 

XS(  J) 

YS  ( J) 

SX<  J) 

SY  ( J) 

SZ  <  J ) 

THE  VECTOR 


*****¥¥¥¥¥¥¥¥¥¥¥¥¥¥#¥¥¥  OTHER  PARAMETERS 


TRIDI 

****#**.*»**¥.,***¥¥¥*¥¥¥¥¥  ¥¥¥¥¥¥¥¥¥¥¥¥¥*¥♦¥¥¥¥¥¥¥¥¥¥¥¥¥¥«*¥¥¥¥¥¥¥  '*’*’?,M‘fTRIOI 

TRIDI 

COMMON  /CNTROL/  IPOUT.ISIN. ISOUT , JPARN , MC (20 ) ,  NSEQO 
COMMON  /INOEX/  ICX  »  JCX . KBHX.LTIMX.NAT ,NCX»  NO A  T  X 


INTEGER  WI NO, TURB. METEOR, RESOL V. SPEC, FORM 

DIMENSION  ZCH(KBHF)  , NET < ICF , JCF)  ,NETSU (NCF) ,VX  CKBHF, NOATF , lTIMF ) 
OIMENSI ON  VYIKBHF ,NCATF, LTIMF ) , V Z (KBHF , NO ATF,L T I MF ) 

DIMENSION  XSIZOO),YS<200),ZS(200),SX(2Cii)),SY(200),SZ(200) 
DIMENSION  D2(2G0> ,NAC(200) ,SCALE<  8» , AP< 6) , FMT (12) 


DATA 
1  / 
DATA 
i 


ALIHIT 

999999. 

J  I  OPF 
/  200 


,  RADC  , 

0  J.74532925, 


,  91 G 
.i.OE+37 


PROG  R  M,  , 
6HTRIOIN, 

CIB 

l.GE-37  / 


1  FORMAT  ( /18X  ,  5HALPHA,  8X,  4HSETA,  14X, 

3  F0RMAT(8X,I8,6E16«4) 

4  FORMAT (/5Xt  62HTHE  CATA  VECTOR  AT  EACH 
1PUTEO  USINGI4,  7H  OUT  OFIh,  15H  INPUT 

FORMATt  ?QI4 ) 

1C  FORMAT ( 8F 10 ♦ 0 ) 


TRIOI 
TRIDI 
TRIOI 
TRIDI 
TRIOI 
TRIDI 
TRIDI 
TRIOI 
TRIDI 

,RESCL V,  WIND  ,  TURB  TRIDI 
,4HRFS0,4HWIND,4HTUR37TRI0I 

TRIDI 

TRIDI 

TRIDI 

2HNN/  15X,  2E12.4,  112)  TRIDI 

TRIDI 

SPACE  LATTICE  CENTER  IS  COMTR1DI 

VECTORS./)  TRIDI 

TRIOI 

TRIOI 


METEOR 

4HMETE 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 
3? 
33 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
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il  FORMAT! 12A6) 

17  FORMAT ! 2F1Q.0 ,  14) 

20  FORMAT !  //53X,  22HSC ALEO 
1  1HZ.  15X,  1HX,  15 X  *  1HY, 

21  FORMAT (  // 50X,  22HSCALE0 
1  1HZ *  15X,  1HX,  15X »  1HY, 

24  FORMAT ( //  78H  NO  VECTORS 
1.  A  RANDOM  SELECTION  OF 
2/  5X,  15H  FOR  GRID  POINT, 
3  5X,  9H!X,Y,Z)=  <  ,  F12 

31  FORMAT (  //5  OX »  22H  RAH 

1  1HZ,  15X,  1HX,  15X,  1HY, 

2  9X ,  2HVZ) 

32  FORMAT (  //47X,  22H  RAH 
1  1HZ,  15X,  1HX,  15  X ,  1HY , 

33  F0RMAT!8X,I8,5E16.4> 


HINO  OATA  /  11X, 

14X,  2HVX,  14X  2HVY, 
TURBULENCE  DATA/  11X, 
12X,  4HEPSX,  10X,  4H 
LIE  WITHIN  THE  SPECIF 
,14,  3 OH  VECTORS  ARE 

*  5 ,  IK ,  ,  FI  2,  3 , IH , , FI 2. 
WIND  OATA  /  11X, 

10X,  1QHVX  OR  CIR,, 

TURBULENCE  DATA/  11X, 
12X,  4HEPSX,  10X,  4H 


5HINOEX,  11X, 

14X ,  2HVZ) 
5HINOEX,  11X, 
EPSY) 

IEC  WEIGHTING  REGI 
EQUALLY  WEIGHTED  , 


3,1H)  ) 

5 HI NOEX, 
6X ,  11HVY 

5HINDEX, 

EPSY) 


11X, 

OR  SPEED 
11X, 


¥¥¥¥¥****¥¥■¥¥¥¥¥¥¥*****¥*¥****¥***¥¥**¥¥¥¥*¥*¥*■*■*■*¥¥¥*¥**¥***¥*¥■*¥*¥ 


OPY  INC 
REA 
ALF 
BET 
IF « 
REA 
REA 
DO 

9  IF  ( 
IF! 
WRI 
REA 
13  IF  ( 
IF  ( 
IF  ( 
I F  ( 
J=0 

COPY  IN  A 
100  REA 
I F  ( 
J  =  J 
OUT 
IF( 
1  AP 
I F  ( 
1  AP 
I F  ( 
7S( 
XS( 
YS< 
SZ( 
IF ! 
SX< 
S  Y  ( 
GO 
SX  ( 
S  Y  < 
GO 
JTO 
IF  ( 
OUT 


ONTROL  PARAMETERS 
0 < IS  IN,  17) ALPHA, BETA, NN 
A2=ALPHA**2 
A2=3ETA**2 
NN  .ECU  0)  NN  =  1 
D(ISIN,  11)  FMT 
0  ( IS  IN,  10 )  SCALE 
9  1=1,3 

SCALE(I)  .EQ.  0,C  )  SCALE(I)  =  1.0 
SCALE (  6I.EQ.  0.0  )  SCALE<  6)=  i.O 
TE (ISOUT ,1)  ALPHA, BETA, NN 
0(ISIN,8)N1,N2,N3  ,N4,N5,N6 

NH-N2+NJ+N4+N5+N6  ,LT  «  21)  CALL  ERROR ( PROGR 
FORM  .EQ.  METEOR)  TRNS  =  SCALE (5 )*SCALE  (3) 
MC  (2 )  .NE.  1  .ANO.  SPEC  .EQ.  WINO)  WRITE! 
MC  (2  *  .NE.  1  .ANC.  SPEC  .EQ.  TURB )  WRITE! 


K, -13, ISOUT) 
-  160. 

I S  CUT,  3 1) 
ISCUT, 32) 


COPY 


50 


101 


;opy 


TMOS 
D  ( IS 
AP.!  N 
♦  1 
RAW 
MC  i  2 
!N5) 
MC  ( 2 
(N5) 
J.  GT 
J)  = 
J)  = 
J)  = 
J)  = 
FOR 
J)  = 
J)  = 
TO  1 
J)  = 
J)  = 
TO  1 
PV  =  U 
MC  (2 
SCAL 


PHERE  OATA  VECTOR  J 
IN, FMT)  AP 

1).GE.  ALIMIT)  GO  TU  101 


OATA 
)  .NE. 

,  AP  !  N6 ) 

)  .NE. 

,  AP ( N6 ) 
.  JTOPF) 
!  A  P  (  N 1 
(APfN5 
!A  P  !N  6 
AP ! N4 ) 
M  .EQ. 
AP(N3) * 
APIN?) * 
00 

AP ! N2 » 
AP! N3) 

CO 


1  .ANT.  SPEC  .EQ.  WIND) 
,AP(N2),AP(N3) ,AP(N4) 

1  .ANC.  SPEC  .EQ.  TURB) 
,AP(N2),AP!N3) 

CALL  ERROR!PROGRM,-1DO,  ISCUT) 
>  ♦  SC  AL  E ( 4) ) *SCALE ( 1) 

)  +  SCALE (7)>*SCALE<6) 

)  +  SCALE18)I¥SCALE(6) 

*  SCALE!  2) 

RESOL  V  .OR.  SPEC  . EQ 
SCALE  !  2)  *  SI N ( 

SCALE  !  2)  *  COS! 


WRITE! ISCUT ,  3)J,AP!N1), 
WRI1E!ISCUT,33)J,AP(N1) , 


RAPC* ( AP !N2) *SCA 
RADQ  *  1 AP ! N2) *  SLA 


TURB  )  GO  TO  50 

LE (3 )  +  TRNS)) 
LE (3)  ♦  TRNS)  ) 


SC  A  LE ( 2 ) 
SC  A  IE  (  2 ) 


).£Q.l)  GO  TO 
ED  INPUT  OATA 


10  2 
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TRIDI 
TRIDI 
TRIDI 
TRIOI 
TRIOI 
TRIOI 
ON TRIDI 
TRIDI 
TRIDI 
TRIOI 
TRIDI 
,  TRIDI 
TRIDI 
TRIOI 
TRIDI 
TRIOI 
TRIDI 
**  TRIDI 
TRIOI 
TRIDI 
TRIDI 
TRIDI 
TRIDI 
TRIOI 
TRIDI 
TRIDI 
TRIDI 
1R1DI 
TRIOI 
TRIDI 
TRIOI 
TRIDI 
TRIOI 
TRIDI 
TRIDI 
TRIOI 
TRIDI 
T  R IO I 
TRIOI 
TRIDIIjO 
TR 10 1 10 1 
TR ID  1 1C  2 
TRI0Ii:3 
TR  ID  1 1 J  4 
TRIDI 1J  5 
TRIO  1 10  6 
TRIDIl j7 
TRIDI106 
TRIDI1U9 
T  R ID  1 11 0 
TRIDI 11 1 
TRI0I112 
TRI0I113 
TRIOI 114 
TRIDI 115 
TRIOI lib 
TRIDI 117 
TRIDI  116 
TR ID  1 119 
TRIOH20 


61 

62 

63 

64 

65 

66 
67 
66 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
01 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 


KirTTr  iTHinigriiTrariBaii 
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IF ( SPEC  .EQ.  WINO)  WRITE (  ISOUT,20> 

IF ( SPEC  .£Q.  TURB)  WRITE(  ISOUT,2i> 

IF ( SPEC  .EQ.  WIND) WRITE(ISOUT,  3 )  (  J,  ZS  <  J> ,  XS  < J  >  ,  YS  ( J)  ,  SX  ( J) 

1  SZ(J),J=1, JTOPW) 

IF  (SPEC  .EQ.  TURB)  WRITE  ( I  SCUT  ,3  3 )  l  J ,  ZS  i  J  )  »XS  <J  >  » YS  < J > ,  SX  <  J )  ,  SY  ( J  ) 
1  ,J=l,JTOPV> 

102  IF (NN.GT .JTOPV  • OR •  NN.LT.  0)  NN=JTOPV 
115  IF(NN.LT.l)  CALL  ERRCR(PROGRM,-115,ISQUT) 

WRITE(IS0UT,4)NN, JTOFV 

COMMENCE  CALCULATION  OF  DATA  VECTOR  AT  EACH  SPACE  LATTICE  CENT tR  POINT 
C  USING  NN  NEAREST  IKPLT  VECTORS 
NN1=NN+ 1 

COMMENCE  LOOP  ON  LATTICE  CENTER  POINTS  IN  THE  HORIZONTAL  PLANE. 

DO  906  NDAT  A=i ,NDAT  X 

CALL  CNTR(NET.NETSU,NOATA,XG,YG, ICF, JCF.NCF) 

COMMENCE  LOOP  ON  ATMOSPHERIC  STRATA. 

00  905  KBH= 1, KBHX 
ZG=  ZCH ( KBH ) 

DO  203  J=i » JTOPV 


C 

C 

C 

C 

C 

C 

C 


202 

203 


C 

C 

C 

C 

C 

C 

C 

c 

C 

c 


SET  ALL  NAD(J)  EQUAL  TO  J  TO  PROVIDE  INDICES 
DATA  POINTS  AND  TO  PROVIOE  AN  INITIAL  SET  OF 
N'AO(J)=J 


FOR  THE  FULL  SET 
-NEAREST-  DATA 


COMPUTE  DISTANCES  BETWEEN  THE  CURRENT 

(XG,YG, ZG)  AND  EACH  CF  THE  INPUT  DATA 

EACH  OF  THE  DATA  VECTOR  LOCATIONS 

TX=XS( J)-XG 

TY=  YS  ( J  )  -Y  G 

TZ=ZS(J)-ZG 

CRESSZ=TZ<‘TZ 

CUTOFF=ALFA2-CRESSZ 

IF( CUTOFF. LE. 0  I  GO  TO  202 

CRES3Z=CUT0FF/(ALFA24CRESSZ) 

CRES5R=TX*TX4TY*TY 

CUTOFF=8ETA2-CRESSR 

IF ( CUTOFF. L E. 0  >  GO  TO  202 

CRESS R= CUT OFF/(BETA2*CRESSR) 

CRESSZ=CRESSZ¥CRE3SR 

IF (CRESSZ. LE.GIB)  GC  TO  202 

D2 ( J) 31 » 0/CRESS Z 

GO  TO  203 

02 ( J) =B IG 

CONTINUE 


LATTICE  CENTER  POINT 
VECTOR  LOCATIONS. 


SET  NAD T=1  TO 
REMOTE  OF  THE 


BEGIN  THE  SORT  PROCEDURE  THAT  SELECTS  THE  MOST 
SET  OF  -NEAREST-  DATA  POINTS.  NOTE  THAT  FOR  THE 


TR1DI121 
TRIDI122 
»SY ( J) , TRIDI 123 
TRIO  1124 
TRIDI125 
T  RIO  II 2b 
TRIOI127 
T  RIDI128 
T  RIOI129 
TRIDI130 
TRIDI131 
TRIDI1J2 
TRIOI1 33 
TRIDI 1 34 
TKlDIl 35 
TRIUI136 
TRIDI1 37 
TRIQI138 
TR1DI1 39 
TRIDI 1 40 
OF  TR1DI141 
F0INTSTRIDI142 
TR1DI143 
TRIDI144 
TRIDI1-45 
TRIDI146 
TRI01147 
TRIDI140 
TR1DI149 
TRID II 50 
TRIOI151 
TRIOI152 
T  RIO  1 1 5  3 
TRIDI154 
T  RID  1 1 55 
TRIDI156 
T  RID  1 1 57 
TRIDI 1 58 
T  RID  1159 
T  RIDI160 
TRIDI 16 1 
T  RID  1162 
TRl'O.T.163 
TRIDI164 
T  RIDI165 
TRI0I166 
1STTRI0I167 


PASS  ALL  THE  NN  -NEAREST- 
REMOTE  OF  THE  SET. 

NADT=1 


POINTS  ARE  EQUALLY  LIKELY  TO  BE  THE 


FIND  THE  AODRESS  OF  ANO  QISTANCE  TO  THE  MOST  REMOTE 
NN  -NEAREST-  POINTS  (THE  POINTS  WHOSE  ADDRESSES  ARE 
NAO ( 1 ) »  NAO ( NN ) . )  STORE  THAT  MAXIMUM  DISTANCE  IN  THE 
SET  NADT  SUCH  THAT  0M=D2 i NAO (NADT ) ) . 

KL=  NAO ( NAD  T) 

0M=0  2 ( KL ) 

00  207  J=1 , NN 
KL=NAO ( J) 

IF ( 0M-02 (KL ) ) 208, 207,207 


THE 


POINT  OF 
GIVEN  BY 
WORD  DM  ANO 


M0STTR10I168 
T  RIO  1 1 69 
TRIO  1 17  0 
TR 10 1 1 71 
T  RID  1 1 72 
TR1DI173 
T  RIO  II 74 
TRIO  1175 
TRI0I176 
TR1DI177 
TRIDI170 
T  RIO  1 1 79 
TRIOIIBH 
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208 

0M=D2(KL) 

TRIDI101 

NADT=J 

TRIDI182 

207 

CONTINUE 

TRI0I183 

C 

AT  THIS  POINT.  OH  IS  THE  LARGEST  D2(J>  FCR  J=N AD ( J) , NAQ( NN> 

TR1DI 104 

C 

TRIOI 185 

IF  (NNi-JTOPV) 2072,2072,2073 

TRIDI186 

C 

TRIDI187 

C2072 

NOW  SELECT  LEST  NN  POINTS 

TRIDI188 

C 

SCAN  THF  SET  0 2 ( J ) , J=NA 0 <NN*1, JTOPV)  UNTIL  A  D2(J)  LESS  THAN  OM 

TRIO I 189 

C 

IS  FOUNO.  IF  ONE  IS  FOUND,  SWITCH  NAO(NAOT)  WITH  THE  SELECTED  NADTRI0I190 

C 

THEN  RESET  OM  AND  NACT  TO  INDICATE  THE  HCST  REMOTE  OF  THE  NEAREST 

T  RID  1191 

c 

NN  POINTS.  WHEN  THE  FULL  SET  D 2 < J) , J=N AC ( NN+1 , JTOPV )  HAS  BEEN 

TRIDI132 

c 

SCANNED,  THE  SET  OF  BAREST  DATA  POINTS  HAS  BEEN  SELECTED.  GNLY 

TRI0I193 

c 

ONE  SCAN  IS  REQUIRED. 

TRIDI194 

2072 

DO  210  J=NN1, JTOPV 

TRIDI195 

KL=NAD< J) 

TRIDI1J6 

IF(DM-02(KL))21Q,210  ,211 

TRIDI197 

211 

NTEMP=NAO( J) 

TRIDI198 

NAD  ( J)  =  NAD ( NADT l 

TRIDI199 

NAD (NADT)=NTEMP 

TRIDI200 

C 

TRI0I2J1 

C 

NOW  RESET  DM  AND  NADT  TO  THE  NEW  NOST  REMOTE  POINT 

TR 101 20  2 

0M  =  D2<KU 

TRI0I233 

DO  212  KKK=i,  NN 

TR1DI2J4 

KL=NAD< KKK) 

TRIDI2J5 

IF<DM-D2(KL)  1213, 212,212 

TRIOI2 J6 

213 

0M=D2(KL) 

TRIQI217 

NADT=KKK 

TRI0I2J8 

C 

TRIDI209 

C 

DM  AND  NAOT  ARE  SET  RITH  THE  PARAMETERS  OF  THE  MOST  REMOTE  OF 

TRI0I210 

C 

THE  NEAREST  NN  POINTS 

T RID  1 211 

212 

CONTINUE 

TR1DI 212 

210 

CONTINUE 

TRIDI2I3 

2073 

CONTINUE 

TRIDI214 

C 

TR 101 215 

c 

THE  NEAREST  NN  HAVE  BEEN  FOUNO 

TRIDI 216 

c 

TRIDI217 

c 

T  RIDI218 

C2080 

COMPUTE  AND  SUM  THE  WEIGHTING  FACTORS 

TR ID  1 2 19 

2080 

SUMsO.3 

TRIDI 220 

DO  214  J=1 , NN 

TRiOI 221 

L=NAO(J) 

T  RID  1 222 

C2(L) =1 . 0/D2 (L) 

TRI0I223 

214 

SUM  =  SUM  +02 ( L ) 

TRIDI 224 

IF(SUM/FLOAT(NN)  .LE.  GI8)  WRITE < I  SO UT , 2 4)  NN, XG  ,Y  G, ZG 

TRIDI 2  25 

C 

TRI0I226 

C 

NOW  COMPUTE  VECTOR  ESTIMATE  AT  LATTICE  CENTER  POINT. 

TR ID  I 227 

C 

COMPUTE  STORAGE  INDEX 

TRI 01 228 

C 

COMPUTE  AND  STORE  VECTOR  ESTIMATE  AT  LATTICE  CENTER  POINT. 

TRI0I229 

VXKNL  =  9 • 0 

TR1DI230 

V YKNL=  0  •  0 

TRI0I231 

VZKNL=0. 0 

TR10I232 

DO  216  J=1 ,  NN 

TRIDI 2  33 

L=NAO(J) 

TRIDI234 

VXKNL=VXKNL+SX (L)¥02(Li 

TRI0I235 

VYKNL=V  YKNL+S  Y  (L)*D2CL) 

TRIDI236 

216 

VZ<NL  =  VZKNL*SZ(U*D2(L) 

T  R ID  1 2  37 

VXKNL=VXKNL/SUM 

1RIDI238 

VYKNL=VYKNL/SUM 

TR ID  1 2  39 

VZKNL=VZKNL/SUM 

138 

TRI0I24U 

Oooooc,  oooooooooCTOonaooooooooooo 


2090  VX(K9H,N0ATA,LTIM)  =  VXKNL  TRIDI241 

VY(K9H,N0ATA,LTIM)  =  VYKNL  TRIDI242 

IF (FORM  .EQ.  TURB)  GC  TO  905  TRIDI243 

VZ( KBH, NOATA, LTIM)  =  VZKNL  TRIDI244 

9C5  CONTINUE  TRIOI245 

906  CONTINUE  TRI0I246 

RETURN  TRIOI247 

END  TR1DI248 


♦OECK.WILKNS  WILKN  i 

SUBROUTINE  WILKNS  ( ZCH, DXSUH , DY SUN ♦ C AV S ,T IMUP, K6HF , NOATF , LT IMF, O  WILKN  2 

WILKN  3 

H.  G.  NORMENT,  ATHOSFHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  WILKN  4 

WILKN  5 

444444*4*44444*44444444  4* 44444444444444444444444  ♦#♦***♦♦*♦♦♦****♦*»*  WILKN  6 

WILKN  7 

WILKINS  FUNCTION  (JAS  20,  473(19631)  IN  THE  FORM  BELOW  IS  USED  TO  WILKN  8 

COMPUTE  TURBULENT  KINETIC  ENERGY  DENSITY  DISSIPATION  RATE,  EPS,  WILKN  9 


WILKN  8 
WILKN  9 
WILKN  10 

EPS=USTAR**3  /  (0,  25MZ  +  ZQ)  I  WILKN  11 

WILKN  12 

WHERE  -  WILKN  13 

USTAR  IS  SURFACE  LAYER  FRICTION  VELOCITY  WILKN  14 

Z0  IS  SURFACE  ROUGHNESS  LENGTH  WILKN  15 

Z  IS  ALTITUDE  ABOVE  GZ.  WILKN  16 

WILKN  17 

USTAR  IS  COMPUTED  FROM  SURFACE  WIND  SPEED  (U),  HEIGHT  AT  WHICH  U  IS  WILKN  18 

MEASURED  ( ZM,  USUALLY  ZM=10  METERS),  ROUGHNESS  LENGTH  ( ZO ) ,  AND  WILKN  19 

RECIPROCAL  MONIN-OBUKHOV  LENGTH  (RL),  VIA  THE  EQUATION  WILKN  20 

WILKN  21 

UST  AR=Q  «  35*U  /  < ALCG(ZM/Z0> +CHI )  WILKN  22 

WILKN  23 

WHERE  CHI  IS  CALCULATED  BY  EXPRESSIONS  GIVEN  BY  BARKER  AND  BAXTER,  WILKN  24 

JAS  14,  620(1975).  WILKN  25 

WILKN  26 

IF  U,  ZM,  ZO,  AND  RL  ARE  NOT  INPUT,  THE  EQUATION  WILKN  27 

WILKN  28 

EPS=0.03/Z  ( M**  2/SEC**  3 )  WILKN  29 

WILKN  30 

IS  USEO.  WILKN  31 

WILKN  32 

j,«4t*4*«444*4»  +  +  ****4******  +  **4*  +  *+4  4*4*4*  **4**  +  *4  + +4*  ***+*♦  +  * +  ***+*  +  4  WILKN  33 

WILKN  34 

COMMON  /CNTRCL/  IPO L T, I  SI N, I SOUT , JPARN , MC ( 20 ) , NSEQO  WILKN  35 

COMMON  /INOEX/  ICX, JCX, KBHX,LTIMX,NAT  ,NCX,NDATX  WILKN  36 

COMMON  /SPACE/  WINT , XLLC  ,YLLC, ZMAX , ZMI N, TIMEX  WILKN  37 

DIMENSION  OX SUM ( KB NF  ,NDA TF , LTIMF ) , CYSUM ( KBHF ,N DATF »  LTIMF I  WILKN  38 

DIMENSION  CAVS(KBHF) .ZCHIKBHF) , T IMUP (LTIMF)  WILKN  39 


UST AR=0 . 35*U  /  (ALCG(ZMZZO) ♦CHI ) 

WHERE  CHI  IS  CALCULATED  BY  EXPRESSIONS  GIVEN  BY  BARKER  AND  BAXTER, 
JAS  14,  620(1975). 

IF  U,  ZM,  ZO,  AND  RL  ARE  NOT  INPUT,  THE  EQUATION 


EPS  =  0.0  3/Z 


( M**  2/SEC**  3 ) 


IS  USEO. 


DATA  PROGRM  ,  VKK  ,  WlLK  ,  ALIMIT 

1  /6HWILKNS  ,  0.35  ,  0.Q3  ,  999999./ 

lUOO  FORMAT ( 4F1Q • 0 ) 

5000  FORMAT (  19X,  1HK,  8X,  3HZCH,  12X,  5HOXSUM,lQX,  5HDY5UM) 

5100  FORMAT (  15X,  15,  3(3X,E12.5)> 


WILKN  35 
WILKN  36 
WILKN  37 
WILKN  38 
WILKN  39 
WILKN  40 
WILKN  41 
WILKN  42 
WILKN  h3 
WILKN  <*4 
WILKN  45 
WILKN  46 


5200  FORMA  T ( 


15X 76HTUR8ULENCE  PARAMETERS  ARE  CALCULATED  BY  WILKINS  RWILKN  47 
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OOO  OOO  O  O  O  OOO  OOO 


.'Aiu.is: 


1ECIPR0CAL  ALTITUDE  FUNCTION/  15X  1QHF0K  UPDATEI3 ,  4H  AT  E12.5,  WILKN 

2  3H  SECONDS/)  WILKN 

5300  FORMAT (  14X,  22HS  UR  FACE  WIND  SPEED  IS  E12.5,  3X,  20H  MEASURED  AT  HWILKN 

1  EIGHT  E12.5V  14X,  1 THROUGHNESS  LENGT  H=E  1 2.  5  ,  3Xf  32HREGI PROCAL  MONWILKN 

2 IN-08UKH0V  LENGTH«Ei2.5,  3X,  iiHIMKS  UNITS)/  WILKN 

3  14X,  32HSIJRFACF.  LAYER  FRICTION  VELOCITY=E12.5  ,  3X  ,  7HCM/SEC)/)  WILKN 
5900  FORMAT (  1H3 .9X07HC ANNOT  COMPUTE  TURBULENCE  VIA  WILKINS  METHOD  BECAWILKN 

1USE  ZCH  ARRAY  HAS  NOT  BEEN  CONSTRUCTED/  10X,  5 3HCALCULAT ION  CANNOTWILKN 

2  PROCEED  UNLESS  WIND  OATA  ARE  INPUT//)  WILKN 

C  WILKN 

CHECK  IF  ARRAY  ZCH  HAS  BEEN  CREATEO  WILKN 

IF(ZCH<1)  .NE.  ALIM  IT)  IF (MG( 2) -1) 50 ,6G , £0  WILKN 

WRITE(ISOUT,5900)  WILKN 

25  CALL  ERROR (PR0GRM,-?5.I SCUT)  WILKN 

53  WRITE(IS0UT,52Q0)L,TIMUP(L)  WILKN 

WILKN 

READ  DATA  USED  TO  CALCULATE  USTAR  (MKS  UNITS)  WILKN 

WILKN 

60  READ(ISIN,10C 0)  U,  ZM,  Z0,  RL  WILKN 

IF ( Z3  .EQ.  O.G)  GO  TC  300  WIlKN 

IF( RL  .GE.  0.0)  GO  TO  100  WILKN 

WILKN 

COMPUTE  CHI  FOR  AN  UNSTABLE  BOUNDARY  LAYER  WILKN 

WILKN 

XI  =  (l.J  -  15.0*ZM*RL>**0.25  WILKN 

CHI  =  -ALOG<<XI**2+1.0>  *  <  XI*  1.  tl)  **2  /8.1)>  ♦  2.0*ATAN  (XI)  WILKN 

1  -  1.570796327  WILKN 

GO  TO  200  WILKN 

100  CONTINUE  WILKN 

WIuKN 

COMPUTE  CHI  FOR  A  NEUTRAL  OR  STABLE  BOUNDARY  LAYER  HlLKN 

WILKN 

CHI  =  4.7*ZM*RL  WILKN 

200  CONTTNUF  WILKN 

USTAR  =  VKK*U  /  (ALCG(ZMZZO)  +  CHI)  WILKN 

C  =  USTAR**3/VKK  WILKN 

IF  (  MC  ( 2  )  .NE.  1)  WRI1E(ISOUT*53JC>U,ZM,ZO#RL, USTAR  WILKN 

GO  TO  40 J  WILKN 

300  C  =  WILK  WILKN 

40U  CONTINUE  WIlKN 

WILKN 

COMPUTE  EPS  AND  STORE  TEMPORARILY  IN  CAVS  WILKN 


40 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 
67 
60 

69 

70 

71 

72 

73 

74 

75 

76 

77 
70 

79 
00 
01 
02 
53 
84 
05 
06 
07 

80 
09 


ZGZ  =  Z  MIN 
DO  5)0  K  =  1 , K3HX 

500  CAVS(K)  =  C/(ZCH(K)  -  ZGZ  Z0> 

LOAD  DIFFUSION  PARAMETER  ARRAYS 

DO  630  N=1 , NO  AT  X 

DO  610  K=1»KBHX 

OXS UM ( K , N, L )  =  CAVS(K) 

600  OYSUM(K,N,L)  =  CAVS(K) 

IF ( MC (2 )  .EQ.  1)  RETURN 
WRITE  (  ISOUT,  5  0  3  0 
PO  730  K=1 , KBHX 

700  WRITECISOUT, 51005  K,  ZCH(K),  OX 
PETURN 


WILKN  90 
WILKN  *1 
WILKN  92 
WILKN  93 
WILKN  94 
WILKN  y 5 
WILKN  96 
WILKN  97 
WILKN  90 
WILKN  j9 
WIlKNI jO 
WILKNld 
WILKN132 
WILKN133 

(KtltL)  ,DYSUM  (  K • 1 , L )  WILKN1.4 

WILKN1 J5 


PNO 


WILKN1  !  6 
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*0  ECK,  CALC  CALC  i 

3 US  ROUT INE  CALC ( IP, CPAP.NMAP)  CALC  2 

C  CALC  3 

C  H.G.NQRMENT  JUNE  25,1971  CALC  4 

C  CALL  5 

C  *  **  *  **  <**♦**  4  **+4.+  ******  ««4**«**«««*«*M«4,**,4«******«**«»,***»*,**,*»Q^|^  g 

C  CALC  7 

C  THIS  SUBROUTINE  COMPLIES  MAP  CONTRIBUTIONS  FOR  INDIVIDUAL  CALC  8 

C  FALLOUT  PARCELS  CALC  9 


C 

calc 

10 

C»# 4444444.4*********  *4*************  GLUSSARV  *******  *****4******4****4**.qh\_q 

11 

C 

calc 

12 

C 

NOB 

SMALLEST 

POSSIBLE  Y 

INDEX  OF  t 

^  CONTRIBUTION  ELLIPSE 

CALC 

13 

C 

NOL 

SMALLEST 

POSSIBLE  X 

INDEX  CF  t 

^  CONTRIBUTION  ELLIPSE 

CALC 

14 

c 

NOR 

LARGEST 

POSSIBLE  X 

INDEX  OF  / 

)  CONTRIBUTION  ELLIPSE 

CALC 

15 

c 

NOT 

LARGEST 

POSSIBLE  y 

INDEX  OF  / 

\  CONTRIBUTION  ELLIPSE 

CALC 

16 

C 

tREL 

Y  COORDINATE  OF  THE 

MAP  POINT 

ROW  CURRENTLY  BEING 

CALC 

17 

c 

CONSIDERED  RELATIVE 

TO  thl  parcel  y  coordinate 

CALC 

18 

c 

XREL 

X  COORDINATE  OF  THE 

map  point 

CURRENTLY  BEING 

CALC 

19 

C 

CONSIDERED  RELATIVE 

to  thl  parcel  X  coordinate 

CALC 

20 

C 

XL 

LEFT  BCLNORY  X  COORDINATE  CF 

THE  PARCEL 

CALC 

cl 

c 

CONTRI  ei’TION  cLLIPSE  IN  THE  YREL  MAF  ROW 

CALC 

22 

C 

XR 

RIGHTBOLNCRY  X  COORDINATE  OF 

THE  PARCEL 

CALC 

23 

c 

CONTRIBUTION  ELLIPSE  IN  THE  YP  EL  MAF  ROW 

calc 

c  4 

c 

NWX 

NUMBER  CF  MAP  POINTS  SPANNED  BY  A  PARCEL 

CALC 

25 

C 

CONCENTRATION  ELLIPSE  IN  A  ROW 

CALC 

26 

c 

VARX2 

2 • 0  *G  7USSIA  N  OISTBN 

.  VARIANCE 

Along  a  axis 

calc 

27 

c 

VARY2 

2.0  *GA USS IA  N  DISTBN 

.  VARIANCE 

ALONG  B  AXIS 

CALC 

26 

c 

F 

MAGNI TUCE(I «E.  INTEGRATED  VALUE)  OF  A  PARCEL 

oAlC 

29 

c 

PROPERTY 

TO  BE  DISTRIBUTED  ON  THE  MAP 

CALC 

i  C 

c 

^ALC 

31 

c 

ALSO  S' 

EE  OPM1  GLOSSARY  AND  PCHECK  GLOSSARY 

CALC 

32 

c 

CALC 

33 

c 

4****4*********. +4***4***  r44*4«*M*4*4,****4*««**44*«<«4«4»**«*««M4,»,^|||i|j 

34 

n 

CALC 

35 

common 

/CONOA  r/ 

IC  <2u) 

,  I  HU  B 

,1PNCH  ,  IPOU  T 

,  CA  LC 

3  6 

11SIN 

, I SOUT 

» jpuur 

,KPOUT 

,KT  AF  t  ,L  TAPE 

,  CALC 

37 

2MARRAY 

,MBT  APE 

,M  XREU 

,30 

,  INPAP 

LA  Lo 

3e 

COMMON 

/MAP0AT7  CAY F 

,CUTMA  P 

,  DGX 

,CGY  » I H  ,IV 

,  lALC 

39 

l.tC 

, NXM  AP 

,NYMAP 

»  NZ 

i DC  UT  ,  SS AM 

,  CALC 

40 

2  TGZ 

»  XGZ 

,xi 

,  X2 

,  YG  Z  ,  X  M  A  X 

,CAlC 

41 

3XMIN 

,  YMAX 

,  Y  MIN 

,ZMIN 

CmLC 

42 

COMMON 

/P  AROAT/ 

ASQ 

,  BSC 

,  CO  S  A  »  F 

,  CALC 

43 

1  GAM  A 

»  KT  R  (1L  0  ) 

*PM  AS ( 13  J  ) 

,psiz(uo) 

, NO  (ICO)  ,SIGXO(100) 

,CAlC 

i*4 

2SIGY0 (1 00) , SINA 

, TPAR ( 10 J) 

, XPAR ( 130) 

»YP  AP (ICG)  .YPRML 

,  C  ALC 

»*5 

3 YPRMU 

fZPAR(lOO  ) 

C  4  LC 

•*6 

COMMON 

/RUNOAT/ 

C 

,0F6 

,  F  S  U  P  ,  I C  T  R 

,  CALC 

H  7 

1MAPRUN 

*  NE 

» NI  J 

,NORO 

,  NR  E  C  *  N  T  A  :>  K 

,  CALC 

48 

2OPMI0U2)  » T1 

,T2 

»  WFMAS  <  C  1 1. , 

) 

CAlC 

49 

DIMENSION  OMAPCNMAP) 

CALC 

50 

DATA  PROGRM/6HCALC  / 

CAlC 

51 

c 

CAlC 

52 

c 

INITIALIZE  FOP  THIS  PARCEL 

CAlC 

53 

c 

CrtLC 

54 

V  A  R  X  2  = 

ASQ/GAM4. 

cALC 

55 

VAR Y2= 

BSQ/GAM A 

CALC 

5  6 

A  =  SINA*COSA* ( 1, 0/VARY 2~  1 . 0 / V ARX 2) *2 .  J 

CALC 

57 

3  =  4, 

0/VARX2/ VARY2 

CALC 

58 

CC=  ( CO S A** 2/ V A R X2  ♦ 

SINA**2/VAR>2)*2.1 

CALL 

59 

0  =  2. 

0 *GAM  A*CC 

CALC 

60 

141 


Q  -  F/SIGXO  (IPI/SIGYCUPI/6. 

28316531 

CALC 

61 

c 

CALC 

62 

c 

COMPOTE  SMALLEST  Y  INDEX  OF 

A  CONTRIBUTION 

CALC 

63 

c 

CALC 

64 

NOB  =  (YPRML  -  YM1M/OGY 

CALC 

65 

N09=N0B*1 

CALC 

66 

IF(NOB. LT.il  NOB»l 

CALC 

6  7 

100 

I F ( MOB. LE. NYM API  GO  TO  120 

CALC 

68 

lie 

IRROR=-llP 

CALC 

69 

GO  TO  AO0 

CALC 

70 

c 

CALC 

71 

c 

COMPUTE  LARGEST  Y  INQEX  OF 

A  CONTRIBUTION 

CALC 

72 

c 

CALC 

73 

120 

NOT  *  ( YPRMU  -  YMIM/DGY 

CALC 

74 

IF(NOT.GT.NYMAP)  NOT*NYMAP 

CALC 

75 

IF  ( NOT •  GT.  0  )  GO  TO  140 

CALC 

76 

130 

IRROR*-130 

CALC 

77 

GO  TO  LOU 

CALC 

78 

c 

CALC 

79 

c 

ENTER  THE  MAP  ROW  LCCP 

CALC 

60 

c 

CALC 

61 

14C 

OO  350  J=N08»  NOT 

CALC 

62 

c 

CALC 

63 

c 

COMPUTE  THE  LIMITING  X  COORDINATES  OF  THE  PARCEL  CONTRIBUTION 

CALC 

64 

c 

ELLIPSE  IN  THIS  ROW 

CALC 

85 

c 

CALC 

66 

YREL  =  J 

CALC 

87 

YREL  *  YfllN  ♦  OG Y*YREL  -  YPAR(IP) 

CALC 

88 

RAO IC  =  -B*YREL**2+G 

CALC 

69 

IF(RAOIC.GE.a.li)  GO  TO  160 

CALC 

90 

150 

RA0IC  =  0  «  0 

CALC 

91 

CALL  ERROR • PROGRH*  150.ISOUT) 

CALC 

92 

160 

RAOIC=SQRT  (RADIO 

CALC 

93 

XL  =  XPAR  ( IP  I  *  (  YREL4  A-  RAOIO/CC 

CALC 

94 

XR  =  XL  +  2. J*RAOIC/CC 

CALC 

9  5 

c 

CALC 

96 

c 

COMPUTE  SMALLEST  X  INDEX  OF 

A  CONTRIBUTION 

CALC 

97 

c 

CALC 

*6 

NOL  =  (XL-X1I/0GX 

CALC 

99 

NOL  =NQL  *1 

CALC 

IwO 

IF( NOL. LT. 1 1  N  0  •.  =  1 

CALC 

I'll 

IF(NOL.GT.NXMAP)  GO  TO  350 

CALC 

1.2 

c 

CALC 

1''  3 

c 

COMPUTE  LARGEST  X  INDEX  OF 

A  CONTRIBUTION 

calc 

lu  4 

c 

CALC 

18  5 

180 

NOR  =  (  XR-X1)  /0GX 

CALC 

1 J6 

IF ( NOR. GT. NXM AP )  NOR  =  N  XMAP 

CALC 

1.7 

IF(NOR. LT.il  GO  TO  350 

CALC 

1'.  8 

200 

NWX  =  NOR  -  NOL 

CALC 

1C  9 

IF(NWX*1)21Q,350,220 

CALC 

110 

210 

IRROR=- 210 

CALC 

111 

GO  TO  400 

CALC 

112 

c 

CALC 

113 

c 

COMPUTE  OMAPIMI  ARRAY  INCEX 

EXTREMES  FOR  MAP  POINTS  IN  THIS  ROW 

CALC 

114 

c 

CALC 

115 

220 

MCRMT= ( J-ll *NXMA  P 

CALC 

116 

K  *  NOL  ♦  MCRMT 

CALC 

117 

L  =  K  ♦  NWX 

CALC 

118 

c 

CALC 

119 

c 

ADJUST  OR  AOO  CONTR IBUTI CNS 

TO  THE  MAP  POINTS 

CALC 

120 

ooooooooooooo 


GO  TO  (224.224.221.  221,  222,222) ♦MORD 

CALC 

CALC 

121 

122 

221 

OMA=TPAR(IP) 

CALC 

123 

GO  TO  224 

CALC 

124 

222 

OMA=PSIZ(IPJ*l.CE6 

CALC 

125 

224 

DO  3C0  M=K,L 

CALC 

126 

GO  TO  (225, 245,230, 240,230, 2401 , NURD 

CALC 

127 

225 

OMAP(M)=OMAP(M)«-l.  C 

CALC 

126 

GO  TO  300 

CALC 

129 

23(1 

OMAP(M)  =  AMINi(OMA,CMAP(M) ) 

CALC 

130 

GO  TO  310 

CALC 

131 

240 

OMA  PCM)  =  AHA XI ( OMA  , CMAP  <M 1 ) 

CALC 

132 

GO  TO  300 

CALC 

133 

24  5 

XRELsM  -MCRMT 

CALC 

134 

XREL  =  XI  ♦  DGX*X REL  -  XPAR(IP) 

CALC 

135 

OMA  =  Q*EXP(  -  (XREL* CO SA  ♦  YREL*SINA) **2/VARX2  -  ( YREL*COSA 

CALC 

136 

1  -  XREL*SINA» **2/VARY2) 

CALC 

137 

250 

OMAP(M)  =  OMAP(M)  ♦  CMA 

CALC 

136 

300 

CONTINUE 

CALC 

139 

350 

CONTINUE 

CALC 

140 

RETURN 

CALC 

141 

400 

CALL  ERROR(PROGRM, IRRCR, 7SOUT) 

CALC 

142 

END 

CALC 

143 

♦ DECK »  CON  TOR  CONTO  1 

SUBROUTINE  CONTOR<  CCNTUR,  CRQL3L  ,UMAP  ,NMAP)  CQNTO  2 

CONTO  3 

H.  G,  NORMENT,  ATMOSFHERIC  SCIENCE  ASSOCIATES  -  JANUARY  1*79  CONTO  A 

CONTO  5 

*♦#».*****#.****.*♦***♦#♦******#*♦*******♦**♦*****♦♦**■***♦**+**♦*#♦*♦*.;•  *CO  NT  0  6 

CONTO  7 

DETERMINE  UNOROEREO  SETS  OF  POINTS  (  A  MAXIMUM  CF  300  IS  ALLOWED  >  CONTO  8 
THAT  LIE  ON  THE  CONTOJRS  SPECIFIED  BY  ARRAY  CONTUR.  LINEAR  CONTO  9 

INTERPOLATION  BETWEEN  MAP  POINTS  IS  USED.  SR  SRTCNT  IS  CALLED  TOC ONTO  10 
OROER  THE  POINTS  IN  SEQUENCE  AROUND  THE  CLOSEO  SECTIONS  OF  THE  CONTO  11 
CONTOURS.  CONTO  12 

CONTO  13 

*«#««»»*««*  «****»*****#**+**"*****«#«*»»»**  +  *#*+*«»  *«****«*«*‘*«**>»**«»qo  NT  0  14 

CONTO  15 


COMMON  /CON  CAT/  IC(2L> 

,  I  HOB 

, IP  NCH 

.ipour 

♦CONTO 

16 

1ISIN  .ISOUT  , JPOUT 

, KPOUT 

,KT APE 

,L  T  APE 

, CONTO 

17 

2MARRAY  ,  MB  TAPE  ,  MXREQ 

,so 

, IN  PAM 

CONTO 

16 

COMMON  /MAPOAT/  CAYF  ,CUTMAP 

,DGX 

,  OG  Y 

,  1 H  ,1  \l 

, CONTO 

19 

1JC  , NX  M  A  P  , NYMAP 

,NZ 

f  QCUT 

,  SS  AM 

, CONTO 

20 

2TGZ  , XGZ  ,X1 

,X2 

,  YG  Z 

,  XMAX 

.CONTO 

21 

3XMIN  , YKAX  , YMIN 

,ZMIN 

CONTO 

22 

OIMENSI ON  OMAP(NMAP) .CONTURI 

6 )  , X ( 30  0  > 

,  Y  (310) 

CONTO 

23 

OATA  PROGRM/6HCONTOR/ 

CONTO 

24 

CONTO 

25 

DO  990  L-l , 8 

CONTO 

26 

IF <  CONTURCLI  .EQ.  C.0»  GO  TO 

999 

CONTO 

27 

CNT  =  CONTUR(L) 

CONTO 

28 

<  =  3 

CONTO 

29 

OMPUTE  CONTOUR  INTERSECTI  (NS  ALONG 

MAP  ROWS 

CONTO 

30 

DO  400  1=1, NYMAP 

CONTO 

31 

DO  400  J=2, NXMAP 

CONTO 

32 

143 


ooooooooooooonooooo 


IF (OMAP ( NX  MAP* ( 1-1 ) ♦J-l)  .LE.  CNT)  IF  (  CMAP  ( NXM  AF *  (1-1)  J  >  -  CNTI 

i  400,200,200 

IF(ONAP(NXMAP*  (I-D+J)  .GT.  CNT)  GO  TO  4C0 
200  K  =  K  ♦  1 

IF C  K  .GT.  31 Q)  CALL  ERROR( PROGRM,  -200  ,  ISOUT) 

Y(K)  =  YMIN  «■  I*  OGY 

X  (K )  =  XMIN  v  ( J-l) *OGX  ♦  (CNT  -  OMAP ( NXMAP* (I -1 )♦ J-i ) ) *OGX/ 

1  (OMAP(  NXMAPMI-1)  *J)  -  OHAP(NXMAP*(I-l>+J-l)> 

400  CONTINUE 

COMPUTE  CONTOUR  INTERSEC TICNS  ALONG  MAF  COLUMNS 
DO  900  J=1 tNXNAP 
OO  900  I=Z,NVMAP 

IF(OMAP(NXMAP*(I-2) *J)  .LE.  CNT )  IF ( OMAP ( NX MAP  * ( 1-1) +J )  -  CNT) 

1  900.700.70C 

IF (OMAP (NX MAP* (1-1 ) ♦  J)  .GT.  CNT)  GO  TO  900 
700  K  -  <  *■  1 

IF  t  <  .GT.  3C0)  CALL  ERRUR(PROGRM.  -701,  ISOUT) 

X (K )  *  XMIN  *  J*  OGX 

Y  (K)  =  YMIN  «•  (1-1)  *OGY  ♦  (CNT  -  OMAP  (  NXMAP*  (I -2  )*  J  > )  *  DGY/ 

1  (OMAP(NXMAP*(I-l) *J)  -  OMAP ( NXMAP* (I -2 ) ♦ J ) ) 

900  CONTINUE 

OO  950  1=1, K 

950  WRITE  (ISOUT  .1000  )  X(I),Y(I).  CNT 
1L  09  FORMAT (  3F10.C) 

CALL  SRTCNT (  X,  Y,  CNT,  K,  CR0L9L) 

990  CONTINUE 
999  RETURN 
ENO 


CONTO  33 
CONTO  34 
CONTO  35 
CONTO  36 
CONTO  37 
CONTO  36 
CONTO  39 
CONTO  40 
CONTO  41 
CONTO  h2 
CONTO  43 
CONTO  44 
CONTO  45 
CONTO  46 
CONTO  47 
CONTO  46 
CONTO  49 
CONTO  50 
CONTO  51 
CONTO  52 
CONTO  53 
CONTO  54 
CONTO  55 
CONTO  56 
CONTO  57 
CONTO  58 
CONTO  59 
CONTO  60 


♦DECK, GOGO  GOGO  i 

SUBROUT INF  GOGO  (  OMA F  , NMA  P)  GOGO  2 

GOGO  3 

H.G.NORMENT  JUNE  28,1971  GOGO  4 

GOGO  5 

n**************************************************.*****************,^^  f, 

GOGO  7 

THIS  SUBROUTINE,  WNICH  IS  CALLED  BY  UPM2  ,  CONTROLS  REAU-IN  OF  GOGO  6 

PARCEL  OATA.  IT  ROLlS  PROCESSING  OF  THE  DATA,  AND  CONTROLS  GOGO  9 

LOADING  OF  THE  OATA  CN  TO  TEHPURY  STORAGE  TAPE.  GOGO  10 

GOGO  11 

GLOSSARY  ********  4  *****  **  **  *********  QQ &Q  12 

GOGO  13 
GOGO  14 
GOGO  15 
GOGO  16 
GOGO  17 
GOGO  16 
GOGO  19 
GOGO  20 

»*»******«•***«  ************  *««*«#****•**.-••*******»*««***  *************Q  JQO  cX 

GOGO  22 


COMMON 

/CONOAT/ 

IC(2L) 

.IHOB 

.IPNCH 

» I  POUT 

,  GOGO 

23 

ilSIM 

.ISOUT 

,  JPOUT 

.KPUUT 

, KT AFE 

, LT  APE 

.GOGO 

24 

2  N ARRAY 

,MBT APE 

.MXREQ 

.SO 

j IN  F AM 

GOGO 

25 

COMMON 

/MAPDAT/  CAYF 

.CUTMAP 

.OGX 

,  CG  Y 

» IH  ,IY 

t  GOGO 

26 

1 JC 

, NX MAP 

.NYMAP 

vN  Z 

»QCUT 

,  SSwM 

,  GOGO 

27 

ICTR  A  CONTROL  PARAMETER  -  WHEN  1CTR.ME.NZ  ,  ANOTHER 

MAP  COKE  LOAO  IS  SIGNALED  TO  FOLLOW 
NIJ  A  BLOCK  COUNT  OF  OATA  STOKtC  ON  TARE  AND/OR  IN  CORE 

N7  NUMBER  CF  MAP  CORE  LOADS  PEQUIREO  9EY0N0  THE  FIRST 

ALSO  SEE  OPM1  GLOSSARY 


2TGZ  « XGZ  ,X1 

,X2  ,YGZ  , 

XKAX  • GOGO 

28 

3XMIN  »  YMAX  »Y  MIN 

t  ZMI N 

GOGO 

29 

COMMON  /PARDAT/  ASQ 

t  BSQ  t  CO  SA  , 

F  ,  GO  GO 

SO 

1  GAMA  «  KTR (160)  »PM  AS  < 10  0 ) 

iPSIZ(lOO)  » RO (100)  , 

SIGXCK100  )  •  GOGO 

31 

2SIGYO  (100) * SINA  ,TPAR(1QQ> 

tXPARt  130  tYPAR(lQO)  , 

YPRML  i GOGO 

32 

3YPRMU  *ZP  AR  ( 10  0 ) 

GOGO 

33 

COMMON  /RUNOAT/  C 

,CF6  »FSUM  , 

ICTR  » GOGO 

34 

1MAPRUN  *  NE  ,NIJ 

,NORD  *  NREG  ♦ 

NTASK  • GOGO 

35 

2 OPMIO (121  f  T1  ,T2 

♦WFMAS (200) 

GOGO 

36 

DIMENSION  OMAP(NMAP) 

GOGO 

37 

DATA  PROGRM/6HGOGO  / 

GOGO 

38 

c 

GOGO 

39 

IJIN=1 

GOGO 

GO 

c 

READ  A  OATA  BLOCK  COUNT 

GOGO 

41 

c 

GOGO 

42 

100  REAO(KTAPE) NIJ 

GOGO 

43 

c 

GOGO 

44 

c 

ARE  WE  FINISHEO  PROCESSING  THE 

OATA- 

GOGO 

45 

c 

GOGO 

46 

IF(NIJ.EQ.O)  GO  TO  400 

GOGO 

47 

IFtNIJ.LE. MARRAY)  GO  TO  200 

GOGO 

48 

150  IRROR=-150 

GOGO 

49 

160  CALL  ERRORCPROGRM,IRROR,ISOUT> 

GOGO 

50 

c 

GOGO 

51 

c 

REAO  A  BLOCK  OF  PARCEL  DATA 

GOGO 

52 

c 

GOGO 

53 

20  0  READ  (KT  APE)  (XTAP.d  ),  YPARdi  ,ZPAR(I)  ,  TP AR <1 > ♦ SI GXO ( 1)  i S1GY O < I >  »  GOGO 

54 

1  RO  ( I)  » PSI Z (I ) « PMA  S  <  I) » '_  1 »  NIJ) 

GOGO 

55 

c 

GOGO 

56 

c 

CALL  PCHECK  TO  BEGIN  PROCESSING 

THE  PARTICLE  OATA  INTO 

A  MAP  GOGO 

3  7 

c 

GOGO 

58 

CALL  PCHECK(IJIN,OMAP,NMAP> 

GOGO 

59 

IF(NZ.cQ,ICTR)  GO  TO  100 

GOGO 

60 

c 

GOGO 

61 

c 

CALL  POMP  TO  DUMP  PARTICLE  OATA  ON  TO  TAPE  FOR  USE  IN 

SUBSEQUENT  GOGO 

62 

c 

MAP  CORE  LOADS 

GOGO 

63 

c 

GOGO 

64 

IF( NX J  .GT.  NE)  CALL  POMP 

GOGO 

65 

GOTO  10O 

GOGO 

6ft 

LOO  RETURN 

GOGO 

67 

END 

GOGO 

66 

oouooooooo 


♦DECK, HAP 

SUBROUTINE 


MAP (OMAP  f NMAP) 
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**********************  ************  ***K-*****  ******<■*  ***********  *******  *^MAP 

MAP 

DELFIC  MAP  PRINTER  MAP 

MAP 

***********  ****a*  ************  **■?•***  *****  ***  *************************  **map 

MAP 


COMMON 

/CONOAT/ 

IC ( 20 i 

.  IKOS 

♦  IPNCH 

i  IPOUT 

.MAP 

13 

11  SIN 

, tSOUT 

» JPUUT 

.KPOUT 

*  KT  APE 

. L  TAPE 

.MAP 

14 

2MARRAY 

»MBT  APE 

.MXREQ 

*SD 

.IN FAM 

MAP 

15 

COMMON 

/MAPDAT/  CAYF 

.CUTMAP 

»DGX 

.  OG  Y 

*  I H  ,IV 

.MAP 

16 

1JC 

, NXMAP 

.NYMAP 

♦  NZ 

.GOUT 

.  SS  AM 

.MAP 

17 

2TGZ 

,  XGZ 

.XI 

.  X2 

.  YG  Z 

.  X  MAX 

.MAP 

18 

3XMIN 

*  YMAX 

.YMIN 

.  ZMI N 

MAP 

19 

COMMON 

/RUNOAT/ 

C 

.CF6 

.FS'JM 

» I CTR 

.MAP 

2C 

1MAPRUN 

*  HE 

»N  I J 

,NORO 

» NR  EC 

.NTASK 

.MAP 

21 

2OPMI0 (1 2)  » Tl 

,T2 

.WFMAS (2J0) 

MAP 

cZ 

COMMON 

/OUTPUT/  FISNUM,FP(2QQ) 

tFWfNDSTR.JGC 

.KASCHN 

»PS(  200)  . 

MAP 

23 

1  FmASS(2QQ)»0*AH(203 > 

DIMENSION  JHAP(20)  .CHAP(NMAP) 

INTEGER  BLANK 

DIMENSION  FMTE'XP(21)  .FMTRUT  (21j  ,A8SSA< 10) 

OAT A  FMTEXP(l) tFMTRUT <11 .FMTEXP ( 21 ) , FM TRUT ( 21 ) . BLA NK , FMT A , FMTF , 

1  FMF I/6H (/IX.  ,6H(5X»  ,6H)  ,6H)  ,6H  ,feHA6  , 

2  6HF6.3  » 6HI6  /.OOT/6H  .  / 


OATA  BITLUM.INC.LREW/  6HMULTIB , 19. 0/ 


FORMAT! 1H1.5HSTRIPI3.5X,  12A6,  5Xt  8HMAP  TYPEI3) 
F0RMAT(/12X,19I6) 

FORMAT ( lH+t  32X,  1 7HTWO-LINE  E  FORMAT) 

FORMAT(1X,F13.0,2X, 19FE.3) 

FORMAT ( lH+t  32 X»  21HTW0-LI NE  Fli.3  FORMAT) 

FORMAT ( 16H0  01 S  PLAY  METHOD  I4.33H  IS  NOT  AVAILABLE.  USED  ME 
FORMAT ( //I 5X»  18HTHIS  MAP  USES  THE  ) 

FORMAT ( //15X»  2  5HTHE  QUANTITY  PRESENTED  IS) 

F0RMAT(15X,43HA  COUNT  OF  CONTRI BUT ING  DEPOSIT  INCREMENTS.) 
FORMAT(15X,42HEXPOSURE  RATE  NORMALIZED  TO  TIME  H+i  HOUR.) 
FORMAT  ( 15X.  24HEXP0  JURE  RATE  AT  TIME  H*Fl0.1»9H  SECONDS:  .  ) 


8HMAP  TYPEI3) 


FORMAT) 


METH90 


MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
MAP 
1.)  MAP 
MAP 
MA» 
hAP 
MAP 
MAP 


F0RMAT(15X,36HEXP0SURE  ACCUMULATED  BETWEEN 
IS  AND  INFINITY.) 

FORMAT ( 15X*  36HEXP0SURE  ACCUMULATED  BETWEEN 
1  ME  H*F10.1,9H  SECONOS.) 

F0RMAT(15X.6JHT0TAL  MASS  PER  UNIT  AREA  OF  C 


H+Flli.  1.  22H  SECONOrtAP 

MAP 

H*F  1 0 . 1  *  12 H  ANO  TIMA1> 

MAP 


F0RMAT(15X,6JHT0TAL  MASS  PER  UNIT  AREA  OF  CONTRIBUTING  DEPOSIT  INCMAP 
1PEMENTS.)  MAP 

FORMAT! 15X, 43HMASS  PER  UNIT  AREA  OEPOSITED  BETWEEN  TIMES  F10.1.5H  MAP 
1 ANO  F10.1.9H  SECONDS.) 

FORMAT ( /  3X .  4H***  ,  1GF12.Q.  3H  **/) 

FORMAT ( 15X . 41H A  SSUM  E  S  ALL  PARTICLES  ARE  GRCUNDEC  3Y 
FORMAT ( 15X»  2  7HACTI VITY  OUE  TO  MASS  CHAIN  14) 

F0RMAT(15X,26HMULTIPLE  BURST  31  NARY  TAPE* 

FORMAT( 15X. 31HGR0UNC  ZERC  IS  LOCATED  AT  X  =  F14.1. 

1 ) 

FORMAT< 15X.46HTIMF  (SECONOS)  OF  ONSET  OF  FALLOUT  OE 
FORMAT ( 15X  * 50HTIME  (SECONDS)  OF  CESSATION  OF  FALLOL 


REA  OEPOSITED  BETWEEN  TIMES  FlO.l.BH  MAP 

MAP 

3H  **/)  MAP 

TICLES  ARE  GRCUNDEC  3Y  Tl.)  MAP 

0  MASS  CHAIN  14)  HAP 

31  NARY  TAPE*  MAP 

LOCATED  AT  X  =  F14.1.8H  ,  Y  =  FlO.lMAP 

MAP 

OF  ONSET  OF  FALLOUT  DEPOSITION.)  MAP 

OF  CESSATION  OF  FALLOUT  DEPOSITION.)  MAP 


,1a 


25 

FORMAT(15X«5CH DIAMETER  (MICRONS)  OF  SMALLEST  OEPOSITEO  PARTICLE. 

)  MAP 

61 

26 

FORMAT ( 15X »  49H0I AMETfcR  (MICRONS)  OF  LARGEST  OEPOSITEO  PARTICLE.) 

MAP 

62 

27 

FORMAT( 15X, 56HMASS  OEPOSITEO  <KGM/M**2)  BY  PARTICLES  IN  THE  SI2E 

RMAP 

63 

1ANGE  * £12. 5»  4H  TO  ,E12.5,  8H  METERS.) 

MAP 

64 

28 

FORMAT(15X,77HH*i  HCL'R  NORMALIZED  EXPOSURE  RATE  RESULTING  FROM  PARMAP 

65 

1TICLES  IN  THE  SIZE  RANGE  ,E12.5,4H  TO  .E12.5.8H  METERS.) 

MAP 

66 

29 

FORMAT! 15X.28HUNITS  ARE  ROENTGENS  PER  HOUR) 

MAP 

67 

30 

FORMAT(15X»19HUNITS  ARE  ROENTGENS) 

MAP 

68 

31 

FURMAT(15X,18HUNITS  ARE  KGM/M**2) 

MAP 

69 

32 

FORMAT(15X»21HUNITS  ARE  CURIES/M**2> 

MAP 

70 

33 

FORMAT i 15X , 56HTI ME  OF  ARRIVAL  ACCOUNTED  FOR  BY  THE  APPROXIMATE  VMETM A P 

71 

1  HOD  • ) 

MAP 

72 

34 

FORMAT(15X»50HT1HE  OF  ARRIVAL  ACCOUNTEO  FOR  BY  THE  EXACT  METHOD. 

)  MAP 

73 

35 

FORMAT ( 15X .  34HUNITS  ARE  EQUIVALENT  FIS0I0NS/M**2) 

MAP 

74 

C 

MAP 

75 

99 

IF(MAPRUN)  101.100,101 

MAP 

76 

100 

DO  1000  1=2,20 

MAP 

77 

FMTEXP( I)=SLANK 

MAP 

78 

ICO  0 

FMTRUT(I)=QLANK 

MAP 

79 

TINC=2, 0CCGX 

MAP 

80 

XCOORO=  XMI N+OGX 

MAP 

81 

V INC=INC 

MAP 

82 

XCINC=VINC*OGX 

MAP 

33 

KK‘.*i 

MAP 

64 

NX=NXMAP 

MAP 

85 

C 

LEFT  IS  USED  HERE  AS  A  TEMPORARY  STORAGE 

MAP 

86 

LEFT=(XMAX-X1) /OGX 

MAP 

87 

C 

PRINT  MAP  TITLE 

MAP 

83 

WRITE  (IS0UT.7) 

MAP 

89 

C 

SELECT  APPROPRIATE  OISPLAY  OPTION  CODE 

MAP 

90 

IF ( JO  )147, 147,131 

MAP 

91 

131 

IF  ( JC  -6)  132,1  32,  147 

MAP 

92 

130 

JC  =1 

MAP 

93 

132 

Nl= JC 

MAP 

94 

GO  TO  ( 141,  14c., 143,  144,  145, 146)  ,N1 

MAP 

95 

141 

ASSIGN  150  TO  N2 

MAP 

96 

WRITE  (ISOUT, 7) 

MAP 

97 

GO  TO  102 

MAP 

98 

142 

ASSIGN  151  TO  N2 

MAP 

99 

WRITE  (ISOUT, 5) 

MAP 

100 

GO  TO  10? 

MAP 

101 

143 

WRITE(IS0UT,19) 

MAP 

102 

ASSIGN  301  TO  N2 

MAP 

103 

IF (LREW .NE. C)  GO  TO  1431 

MAP 

104 

LREW=1 

MAP 

105 

REWIND  MBTAPE 

MAP 

106 

143  3 

.  WRITE  (MBTAPE) BITlUM 

MAF 

107 

WRITE  (MBTAPE)  XMIN,  XHA.X,  YMIN  ,  YMAX  ,  OGX  ,OG  Y 

MAP 

106 

GO  TO  102 

MAP 

10  9 

C 

MAP 

110 

q***.**.##**.,.*********.***^*  qqq£  insertion  points  ***** *********** *♦♦*«***  p 

111 

144 

CONTINUE 

MAP 

112 

145 

CONTINUE 

MAP 

113 

146 

CONTINUE 

HAP 

114 

q«*»*4»*j***^**»»»v+****  COOE  INSERTION  POINTS  ************************m ap 

115 

c 

MAP 

116 

147 

WRITE  C.S0UT,6)N1 

MAP 

117 

GO  TO  130 

MAP 

116 

101 

KKL  =  1 

MAP 

xl9 

MXsNXMAP 

MAP 

120 

147 


c 

LEFT  IS  USED  HERE  AS  A  TEMPORARY  STORAGE 

HAP 

121 

LEF7=(XMAX-Xi)/DGX 

MAP 

122 

GO  T0  1702 

MAP 

123 

C  iC2 

PRINT  GRQINATE  DESCRIPTION 

MAP 

124 

c 

MAP 

125 

10  2 

WRITE  ( ISOUT »  8  > 

MAP 

126 

c 

NREQ  1,  2 ,  3,  4,  5,  6,  7,  t,  5,  10,  11,  12,  13,  14,  15, 

MAP 

127 

GO  TO v 161, 162,163,177,164,165,166,169,164,165, 166,167, 176, 171,112, 

MAP 

126 

1 

173,174,175) , NREQ 

MAP 

129 

c 

NREQ  -  16,  17,  18 

MAP 

130 

161 

WRITE  (ISOUT, 9> 

MAP 

131 

GO  TO  170 

MAP 

132 

162 

WRITE  (ISOUT, 10) 

MAP 

133 

WRITE  (ISOUT, 29) 

MAP 

134 

GO  TO  1 7 J 

MAP 

135 

163 

WRITE  (ISOUT, 11)T1 

MAP 

136 

WRITE  (ISOUT, 29) 

HAP 

137 

GO  TO  170 

MAP 

138 

164 

WRITE  (ISOUT,  12)  TJ 

MAP 

139 

WRITE  (ISOUr,30) 

MAP 

140 

IF ( NREQ  . EQ.  9)  GO  TO  1264 

MAP 

141 

1164 

WRIT£(ISOUT,33) 

MAP 

142 

GO  TO  17C 

MAP 

143 

1264 

WRITE(ISOUT»34) 

MAP 

144 

GO  TO  170 

MAP 

145 

165 

WRITE  (ISOUT, 13) T1.T2 

MAP 

146 

WRITE  (ISOUT, 3G) 

MAP 

147 

IF(  NREQ-1Q)  116  4,  126  4,12  64 

MAP 

148 

166 

WRITE  (ISOUT, 14) 

MAP 

i*+9 

WRITE  (ISOUT, 31) 

MAP 

150 

GO  TO  173 

MAP 

151 

167 

WRITE  (ISOUT, 15) T1,T2 

MAP 

152 

WRITE  (ISOUT, 31) 

MAP 

153 

GO  TO  17 J 

MAP 

154 

166 

WRITE  ( ISOUT, 13) Ti ,12 

MAP 

155 

WRITE  ( ISOUT, 30) 

MAP 

156 

WRITF(IS0UT,17) 

MAP 

157 

GO  TO  170 

MAP 

1 58 

169 

WRITE  (ISOUT, 12) Tl 

MAP 

159 

WRITE  (ISOUT, 30) 

MAP 

160 

WRITE  (ISOUT, 17) 

MAP 

161 

GO  TO  173 

MAP 

162 

171 

WRITE  ( ISOUT, 16) MASCHN 

MAP 

163 

IF ( Tl-TGZ  * G V •  0.0)  WRI TE ( I SOUT , 32) 

MAP 

164 

IF ( T 1-T  GZ  .EQ.  0.0)  WRI TE ( I  SOU T , 35 ) 

MAP 

165 

GO  TO  170 

MAP 

166 

172 

WRITE  (ISOUT, 23) 

MAP 

167 

GO  TO  170 

MAP 

168 

173 

WRITE  (ISOUT, 24) 

MAP 

169 

GO  TO  170 

MAP 

170 

174 

WRITE  (ISOUT, 25) 

MAP 

171 

GO  TO  170 

MAP 

172 

175 

WRITE  (ISOUT, 26) 

MAP 

173 

GO  TO  173 

MAP 

174 

176 

WRITE  (ISOUT, 27)  T1.T2 

MAP 

175 

GO  TO  170 

MAP 

176 

1 77 

WRITE  (ISOUT, 28)  Tl,T2 

MAP 

177 

WRITE  (ISOUT, 29) 

MAP 

178 

GO  TO  173 

MAP 

179 

C 

MAP 

180 

148 


aassmsw^r^.  ■■  niTn^-gariM**** 


q*w****»*«****«*»«*«»****  COO E  INSERTION 

POINTS  ♦♦**•*#***♦************** MAP 

181 

ITS 

CONTINUE 

MAP 

192 

179 

CONTINUE 

MAP 

183 

q************************  CODE  INSERTION 

POINT  p  *¥***•***•****♦■¥*  ***+*****MAP 

184 

C 

MAR 

185 

170 

WRITE  C ISQUT, 20 )  XGZ,YGZ 

MAP 

186 

1702 

IFCLEFT-NX)  1021,1022,1022 

MAP 

187 

1021 

NX=LEFT 

MAP 

188 

1022 

MM=NX/(INC) 

MAP 

189 

MAP 

190 

C 

LEFT  IS  USED  HERE  AS  THE  NUMBER  CF 

PRINT  COLUMNS  IN  THE  LAST 

MAP 

191 

C 

PRINTER  STRIP 

MAP 

192 

LEFT- NX -MM* (INC) 

MAP 

193 

IF  CLEFT. NE.0I  GO  TC  2023 

MAP 

194 

M  =  MM 

MAP 

195 

LEFT  =  INC 

MAP 

196 

C 

STRIPS 

MAP 

197 

2023 

DO  110  ISTRIP=1,M 

MAP 

198 

MAPRUN=MAPRUN*1 

MAP 

1*9 

IF  CJC  .EQ.3)  GO  TO  1023 

MAP 

2u0 

ABSSA<1)=XCOORO 

MAP 

201 

DO  3023  IAB=2,iC 

MAP 

202 

3023 

ABSSA(IAB»=A3SSA  tIAe-1  )*TINC 

MAP 

2!i3 

WRITE  CISOUT»l>hAPRUN,CPMIO,NREQ 

MAP 

£0  4 

WRITE  ( ISOUT,  16)  ABSS'A 

MAP 

205 

1023 

KL-KKL+  <NYMAP-1)*NXFAP 

MAP 

206 

IF(ISTRIF-M)103,104,103 

MAP 

2  j  7 

10  4 

KINC=LEFT-1 

MAP 

Zc  8 

VLEFT=LEFT 

MAP 

2  J  9 

XCIN=VLEFT*OGX 

MAP 

210 

GO  TO  .10  31 

MAP 

211 

1C  3 

KINC=I NC-i 

MAP 

212 

XCIN=XC INC 

MAP 

213 

1031 

CONTINUE 

MAP 

214 

PLINK  =  K1NC*1 

MAP 

215 

IF CJC  .  EQ  .  3)  WPITC  CMBT  APE) NYMAF, 

KLINK 

MAP 

£16 

C 

MAP 

217 

c 

ROWS 

MAP 

218 

YY=YMIN+OGY*FLOAT<  NYMAP) 

MAP 

219 

OU  2C0  J=1 , NYM A P 

MAP 

220 

KM=KL+K INC 

MAP 

221 

KOC-O 

MAP 

222 

DO  201  K=KL ,  KH 

MAP 

223 

IF  COMAP  CK) .LT,CUTMAF>OMAPCK)=3.0 

MAP 

224 

201 

FS'JM-FSUM+OMAPC K> 

MAP 

225 

C 

MAP 

226 

0 

NUMBERS  WITHIN  ROWS 

MAP 

227 

DO  300  K=KL , KH 

MAP 

228 

KOC=KDC+l 

MAP 

229 

C 

TRANSFER  TO  CGCE  FOR  SELECTED  PRESENTATION 

MAP 

230 

GO  TO  N 2, (  150, 151,  301) 

MAP 

231 

C 

MAP 

2  32 

C  150 

CODE  FOR  POWER  OF  TEN  DISPLAY 

MAP 

233 

150 

IF  <  OH AP  <  K) )  105,106,  107 

MAP 

234 

105 

ASSIGN  121  TO  N3 

MAP 

235 

0M4PCK) =-OM AP  C  K ) 

MAP 

286 

GO  TO  109 

MAP 

237 

1C  7 

ASSIGN  300  TO  N3 

MAP 

238 

109 

H  =  ALOG10 (ONAPCK) ) 

MAP 

239 

Hi  =  AMOO  CH, l.G) 

MAP 

2*0 

149 


JMAPCKDC)=H-K1 

MAP 

241 

IF* JMAPCKDCKEQ.O) JMAPCKDC)=0 

MAP 

242 

FMTEXPC  KOC+1)  =  FMT  I 

MAP 

243 

FMTRUTC  KDC  +  i)  =  FMTF 

MAP 

244 

IF  CJMAPCKOC) .NE.O)GC  TO  1090 

MAP 

245 

JMAPCKDC)*0 

MAP 

246 

FMTEXPCKDC+l)  =  FMT  A 

MAP 

247 

1090 

OMAPCK)  =  10. 0*#H1 

MAP 

248 

IF ( OHAP C  K) -9.999)115*115*1091 

MAP 

249 

1091 

OMAP(K) =OMAPCK)/10. 0 

MAP 

250 

JMAPCKOC)* JMAPCKOC) +1 

MAP 

251 

FMTEXPC  KOC  +  1)  =  FM7I 

HAP 

252 

GO  TO  115 

MAP 

253 

106 

JMA  P ( KDC  )  =  0 

MAP 

254 

OMAPCK) =0. 0 

MAP 

255 

FMTEXPC KDC+1)  =  FMT  A 

MAP 

256 

FMTRUTCKOC+1)  =  FMT  A 

MAP 

257 

GO  TO  30U 

MAP 

258 

115 

GO  TO  N3,C  300,121) 

MAP 

259 

C  121 

RESET  SIGN  OF  MAP  CCCRDINATE 

MAP 

260 

121 

OMAPCK) =-OMAPCK) 

MAP 

261 

GO  TO  300 

MAP 

262 

C 

MAP 

263 

C  151 

COOE  FOR  TWO-LINE  F11.3  DISPLAY 

MAP 

264 

151 

JMAPCKOC )  =  OMAP  CKI/10 .0 

MAP 

265 

7MAP= JMAPCKOC) 

MAP 

266 

OMAPCK) =OMAPCKI-CZMAF+lQ.Q> 

MAP 

267 

FMTEXPC  KQC+1) =  FMTI 

MAP 

268 

FMTRUTCKDC+1>  =  FMTF 

MAP 

269 

FMTEXPC  KOC  +  1)  =FMT A 

MAP 

270 

FMTRUT  C  KOC  +  1) =FMT  A 

MAP 

271 

300 

CONTINUE 

MAP 

272 

WRITE  Cl.  SCUT*  2  )  CJMAFCK)  ,K=i*KOC) 

MAP 

273 

WRITE  Cl SOUT  *4  >  YY  *  COM AP < K ) , K=KL , KH ) 

MAP 

274 

YY= YY-OGY 

MAP 

275 

GO  TO  200 

MAP 

276 

301 

WRITE  C  MOT  APE )  COMAF (K ) *K=KL*KH) 

MAP 

277 

200 

KL=KL-NXMAP 

MAP 

278 

IF  CJC  .  EQ.3)  GO  TO  110 

MAP 

279 

WRITE  CIS0UT,16)ABSSA 

MAP 

280 

XCOORO* XCOORD+XC IN 

MAP 

261 

no 

KKL  =  KiU+INC 

MAP 

282 

111 

RETURN 

MAP 

263 

ENO 

MAP 

284 

150 
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*  DECK* OPMEX 

SUBROUTINE  OPMEX 


(NUMTAP) 


H.  G.  NORMENT,  ATNCSPHERIC  SCIENCE  ASSOCIATES  -  OECEHBER  1978 


OLTPUT  PROCESSOR  MODULE  ************ 


t****.**********************^ glossary  *****>»************** ******* 

CAYF  ACTIVITY  K  FACTOR  USED  FOR  AIRBURSTS  AND 

ARBITRARY  PARTICLE  SIZE-ACTIVITY  DISTRIBUTIONS. 

( R-M**2) / (HR-KT) 

C  ACTIVITY  DECAY  FACTOR  (NR£Q=5,6> 

CUTMAP  CUT-OFF  THRESHOLD  FOR  NAP  ORDINATE  VALUES 

DELTAX  MAXIMUM  WIDTH  OF  A  CORE-LOAO  PAP 

OET ID (  )  ICRM  IDENTIFICATION 

OGX,  DGY  MAP  GRID  POINT  SEPARATION  DISTANCES  IN  THE 

X  AND  Y  DIRECTIONS 

DIAM(I)  PARTICLE  SIZE  CLASS  UPPER  BOUNDARY  DIAMETERS  (M> 

(CALLED  PACT  IN  PAM) 

OTMIO (  )  07 P  IDENTIFICATION 

FMASS(I)  FALLOUT  MASS  FRACTION  IN  EACH  PARTICLE  SIZE 

CLASS  FOR  A  LOGNORMAL  SIZE  OISTBN.  FOR  AN 
ARBITRARY  SIZE-ACTIVITY  OISTBN.  IT  IS  THE 
ACTIVITY  FRACTION  IN  EACH  PARTICLE  SIZE  CLASS. 

FP ( I )  TOTAL  RAOIQACTIVITY  IN  EACP  SIZE  CLASS 

FSUM  SUM  OF  ALL  MAP  POINT  ORDINATES 

FW  FISSION  YIELO  <KT) 

GRUFF  A  C0M8INE0  GROUND  ROUGHNESS  ANC  RADIATION  METER 

RESPONSE  FACTOR  (DEFAULT  VALUE  =  0.5) 

IC(J)  RUN  CONTROL  VARIABLES 

IC(i  )  . GT . 3  NC  MAPS  ARE  TO  3 E  PRODUCED 

IC(2  I.GT.C  PRINT  CONTENTS  OF  TAPE  IPOUT 

ICTR  SEE  GOGO  GLOSSARY 

IGO  (LOGICAL)  T  COMPUTE  ACTIVITY,  F  COMPUTE  ATOMIC  ABUNDANCES 

IHOB  .GT.  G  INDICATES  AN  AIRBURST 

IH  PRINTER  DESCRIPTION--  NUMBER  OF  CH ARCTERS/INCH 

ACROSS  A  PAGE  CF  PRINTED  OUTPUT  (IH»10) 

IV  PRINTER  DESCRIPTION--  NUMBER  OF  CHARCTERS/ INCH 

DOWN  A  PAGE  CF  PRINTEO  OUTPUT  (IV=6> 

INC  NUMBER  OF  MAP  ORDINATE  COLUMNS  THAT  CAN  BE 

ACCOMOCATED  BY  THE  PkINTER  PAPER 
INPAM  PAP  INPUT  OATA  TAPE 

IPNCH  SYSTEM  PUNCH  TAPE 

IPOUT  DTP  BINARY  OUTPUT  TAPE.  CONTAINS  FALLOUT  PARCEL 

DATA  FOR  USE  BY  THE  OPM 
ISOUT  SYSTEM  OUTPUT  TAPE  NUMBER 

ISIN  SYSTEM  INPUT  TAPE  NUMBER 

IRROR  ERROR  STOP  TRACE  WORD 

JC  MAP  FRINT  FORMAT  CONTROL 

JC=1  2  LINE  E  FORMAT  (THIS  IS  USED  ON  INPUT  OEFAULT) 

JC=2  2  LINE  F11.3  FORMAT 

JO  (LOGICAL)  T  COMPUTE  EXPOSURE  RATE,  F  COMPUTE  OOSE 

JGO  PAM  CONTROL  PARAMETER 

1  COMPUTE  OISTBN  WITH  PART. SIZE  CF  ALL  FiSS. PRODS. 

2  COMPUTE  OISTBN  WITH  PART. SIZE  CF  CNE  MASS  CHAIN 

3  COMPUTE  INOUCED  ACTIVITY  ONLY 

KOOS  (LOGICAL)  T  COMPUTE  COSE  FROM  TIMES  TENTER  TO  TEXiT 

F  COMPUTE  OOSE  FROM  TIMES  TENTER  TO  INFINITY 
KTR(I)  SEE  PCHECK  GLOSSARY 


FP  (  I ) 

FSUM 

FW 

GRUFF 
IC(  J) 

IC(i  )  .  GT . 0 
I  C  (  2  ) • GT • C 
ICTR 

IGO  (LOGICAL) 

IHOB 

IH 


INPAM 

IPNCH 

IPOUT 

ISOUT 

ISIN 

IRROR 

JC 

J  C=1 
JC  =  2 

JO  (LOGICAL) 
JGO 

1 

2 

3 

KOOS  (LOGICAL) 
KTR(I) 


OPMEX  1 
OPMEX  2 
OPMEX  3 
OPMEX  4 
OPMEX  5 
OPMEX  6 
UPMEX  7 
OPMEX  8 
OPMEX  9 
OPMEX  10 
OPMEX  11 
OPMEX  12 
OPMEX  13 
UPMEX  14 
OPMEX  15 
OPMEX  16 
OPMEX  17 
OPMEX  18 
OPMEX  19 
OPMEX  20 
OPMEX  21 
OPMEX  22 
OPMEX  23 
OPMEX  24 
OPMEX  25 
OPMEX  26 
OPMEX  27 
OPMEX  28 
OPMEX  29 
OPMEX  30 
OPMEX  31 
OPMEX  32 
OPMEX  33 
OPMEX  34 
OPMEX  35 
OPMEX  36 
OPMEX  37 
OPMEX  38 
OPMEX  39 
OPMEX  40 
OPMEX  41 
UPMEX  42 
O^MEX  43 
OPMEX  44 
C/PMEX  45 
OPMEX  46 
OPMEX  47 
OPMEX  48 
OPMEX  49 
OPMEX  50 
UPMEX  51 
OPMEX  52 
OPMEX  53 
OPMEX  54 
OPMEX  55 
OPMEX  56 
OPMEX  57 
OPMEX  56 
OPMEX  59 
OPMEX  60 
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oooooooooooooooooooooooooooooooooonoooooooooooooooooooooooo 


MARRAY 
HASCHN 
H9T APE 
MXREQ 
NOSTR 

NE 

NIJ 

NMAP 

NOL 


NOR 


NORD 


NOX 

NREQ 

NRQ 

NST 

NTASK 

NUMT  AP(  ) 

NXMAP 

NYMAP 

MZ 

OMAP(J) 
OPMIOt  ) 
PSCI) 

ocur 

SLDTMP 
TEX  I  T 

TIME, TENTER 
TMSO 
T1.T2 
W 

WFMAS ( I ) 


XPAR,YPAR,ZPAR 
TPAR, SIGXO.S 
RO , PS IZ, PMAS 
XMAX.XMIN 
YMA  X, YM  IN 
XI,  X2 


FALLOUT  PARCEL  DATA  ARRAYS  DIMENSION 
MASS  CHAIN  NUMBER  FOR  A  NREQ  =  1 A  REQUEST 
KUTIBURST  OUTPUT  TAPE 

MAXIMUM  NUMBER  OF  PROCESSING  REQUEST  TYPES 
NUMBER  OF  PARTICLE  SIZE  CLASSES  (CALLED  ITAB 
PAM) 

SEE  PCHECK  GLOSSARY 
PARCEL  BLOCK  COUNT 

MAXIMUM  NUMBER  OF  MAP  POINTS  IN  A  MAP 
SMALLEST  X  INOEX  OF  A  MAP  POINT  TO  THE 


THE  LEFT  BOUNOARY 
CF  A  PARCEL 
LARGEST  X  INOEX  OF  A 
THE  RIGHT  BOUNOARY  OF 
OF  A  PARCEL 
RCUTING  PARAMETER  FOR 
AT  MAP  POINTS  -  - 

1  -  PARCEL  COUNT 


OF  THE  CONTRIBUTION 


MAP  POINT  TO  THE 
THE  CONTRIBUTION 


LEFT  OF 
ELLIPSE 


PARCEL  CONTRIBUTIONS 


2  - 


3 

A 

5 

6 


(NREQ=1> 

STRAIGHTFORWARD  ADDITION  OF  THE 
GAUSSIAN  DISTRIBUTED  QUANTITY  TO 
HAP  POINT  (NREQ=2-14> 

TINE  OF  ONSET  (NREQ  =  15) 

TIME  CF  CESSATION  <  NfiEQ=16) 

SMALLEST  PARTICLE  SIZE  <NKEQ=17) 
LARGEST  PARTICLE  SIZE  ( NREQ=lo ) 
TOTAL  NUMBER  OF  MAP  POINTS  ON  THE  X  AXIS, 
INCLUDING  ALL  CORE  LCACS 
COMPUTATION  OPTION  CODE 
A  COUNTER  FOR  MAP  REQUESTS 
TALLY  CF  PARTICLE  DATA  BLOCKS 
A  TALLY  OF  MAP  SPECIFICATIONS 
TAPE  NLMBER  ARRAY 
NUMBER 
L  CAD 
NUMBER 
L  CAD 
NUMBER 
THE  FIRST 

THE  MAP  ORDINATE  ARRAY 
OUTPUT  PROCESSOR  I OE NT  IF IC AT  I C N 
PARTICLE  SIZE  CLASS  CENTRAL  DIAMETERS (M) 
CUT-OFF  THRESHOLD  FOR  AN  INDIVIDUAL  OEPOSIT 
INCREMENT  CONTRIBUTION 

SOIL  SOLIOIFICAT ION  TEMPER AT URE( CEG,  K) (FROM 


OPMEX  61 
OPMEX  62 
OPMEX  63 
OPMEX  64 
IN  OPMEX  65 
OPMEX  66 
UPMEX  67 
OPMEX  66 
CORE  LUAOOPMEX  69 
RIGHT  OF  OPMEX  70 
ELLIPSE  OPMEX  71 
OPMEX  72 
OPMEX  73 
OPMEX  74 
OPMEX  75 
OPMEX  76 
OPMEX  77 
OPMEX  76 
OPMEX  79 
EACH  OPMEX  60 
OPMEX  ol 
OPMEX  62 
UPMEX  63 
OPMEX  64 
OPMEX  o 5 
OPMEX  66 
OPMEX  37 
OPMEX  68 
OPMEX  89 
OPMEX  90 
OPMEX  91 
OPMEX  92 


OF 

MAP 

POINTS 

ON 

THE 

X  AXIS 

IN  A 

MAP 

COREOPMEX 

93 

OPMEX 

94 

OF 

MAP 

POINTS 

ON 

THE 

Y  AXIS 

IN  A 

MAP 

COREOPMEX 

95 

OPMEX 

96 

OF 

MAP 

CORE  LOADS 

REQUIREO 

IN  A OOI TION  TOOPMEX 

57 

OPMEX  98 
OPMEX  99 
OPMEX1 JO 
OPMEX1J 1 
OPMEX 1J  2 
OPMEX1J3 
CRMOPMEX104 


TIME  RELATIVE  TO  SHOT  TIME  CORRESPONDING  TC  T2  OPMEX1J5 
TIME  RELATIVE  TO  SHOT  TIME  CORRESPONDING  TO  T1  OPMEX136 
TIME  OF  SOIL  SCLIO  IFICATION(  FROM  CRM  MSEC)  OPMEX1J7 
REQUEST  TIME  ARGUMENTS  OR  PARTICLE  SIZES  OPMEX108 
TOTAL  EXPLOSION  ENERGY  YIELD  (KT)  OPMEX1j9 
TOTAL  MASS  OF  FALLOUT  IN  EACH  PARTICLE  SIZE  OPMEXliO 
CLASS/  GRUFF  FCR  A  LOGNORMAL  PARTICLE  DIST6N.  OPMEXlli 
ACTIVITY  FRACTION  IN  EACH  SIZE  CLASS/GRUFF  FCR  OPMEX112 


AN  ARBITRARY  PARTICLE  SIZE- 
,  FALLOUT  PARCEL  DESCRIPTION 

IGYO  , 


ACTIVITY  D1STRIBUTIONUPMEX113 


OATA  (ALL  INDEXED) 


MAXIMUM  ANO  MINIMUM  X  COORDINATES 
MAXIMUM  ANO  MINIMUM  Y  COORDINATES 
X  AXIS  BOUNORY  COORDINATES  OF  THE 
CORE  LOAO 


OF  THE  MAP 
OF  THE  MAP 
CURRENT  MAP 


OPMEX114 
OPMCX115 
0PHEX116 
OP ME  Xl 17 
OPMEX116 
UPMEX119 
OPMEX120 
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(M  RELATIVE  TO  MSL) 
T/W**  (i.0/3.4)  ) 


ZMIN  OEPOSI TION  PLANE  ALTITUDE  (M  RELATIVE  TO  MSL)  OPMEX12:!. 

ZSCL  SCALED  HEIGHT  OF  BURST  tF  T/ W **  (1 . 0/3  •  4)  )  OPMEX122 

UPMEX123 

•  *«.»4*44444444‘4444**4*A4*,4' 4444444444444 .444  44  444  44  44444-4*4444444444444  QP(^£)(124 

OPMEX125 

COMMON  /CONDAT/  IC<20)  ,IHOB  .IPNCP  .IPOUT  .OPMEX126 

1ISIN  .  ISOUT  , JPOUT  .KPOUT  » XT  AP E  .LTAPE  * OPMEX12? 

2MARRAY  .MBTAPE  ,  HXfiEQ  ,SD  .INPAR  OPMEX128 

COMMON  /MAPDAT/  CAY  F  .CUTMAP  ,DGX  .OGY  »IH  ,IV  , OPMEX129 

1JC  » NXMAP  .NYMAP  ,NZ  ,OCUT  ,SSAM  .OPMEX13C 

2  TGZ  •  XGZ  .XL  ,X2  ,YGZ  ,XMAX  , OPMEX131 

3XMIN  *  YMAX  v'rMIN  ,ZMIN  OPMEX132 

DIMENSION  NUMTAP (i  c-‘ ,OMAP  <  5300)  OPMEX133 

UAT  A  NMAP  ,  MARRAY  ,  MXREQ  ,  I H  ,  IV  0PMF.X134 

1  /  5000  ,  100  ,  18  ,  10  ,  6  /  QPMEX1J5 

OP ME  XI 86 

ISIN  =NUMTAP(  1)  OPMEX137 

ISOUT=NUMTAP(  2>  UPMEX1 38 

IPOUT=NUMTAP«  3)  OPMEX139 

JPOUT=NUMT  AP(  5)  OPMEX140 

KPQUT=NUMTAP<  6)  OPMEX141 

IPNCH=NUMTAP<  7)  OPMEX142 

HBTAPt>NUMTAP<8)  OPMEX143 

XNPAM=NUM7 AP(  9)  UPMEXJ  44 

CALL  OPM1  0PMEX145 

CALL  0PM2 <  OHAP.NMAP)  OPMEX146 

RETURN  OPMEX147 

END  0PMEX148 


COMMON 

/CONDAT/ 

XC<20> 

.  IHO  B 

,  IPNCP 

, IPOUT 

1ISIN 

, ISOUT 

» JPOUT 

.KPOUT 

V XT  APE 

.LTAPE 

2MARRAY 

.MBTAPE 

, HXfiEQ 

.SD 

» INPAM 

COMMON 

/MAPDAT/  CAY F 

.CUTMAP 

tOGX 

♦  OGY 

.IH  , 

1 JC 

.NXMAP 

♦NYMAP 

.NZ 

,OCUT 

.  SSAM 

2  TGZ 

.XGZ 

.XL 

s  X2 

,YGZ 

,  X  M  AX 

3XMIN 

.YMAX 

v'rMIN 

»  Z  MIN 

DIMENSION  NUMTAP (is* 

,OMAP< 

5300) 

UAT  A 

NMAP  , 

MARRAY 

,  MXREQ 

.  IH  , 

IV 

1  / 

5000  , 

100 

.  18 

.  10  . 

6  / 

ISIN  =NUMTAP(  II 
ISOUT=NUMTAP<  2) 
IPOUT=NUMTAP«  3) 

JPOUT=NUMT  AP(  5) 
«POUT=NUMTAP<  6) 

I PNCH=N  UMT  AP  <  7) 
MBTAPK=NUMTAP<8) 

INPAH^NUMT AP(  9) 

CALL  OPM1 

CALL  0PM2<0HAP»NMAP) 

RETURN 

END 


♦DECK. OPMI  OPM1  1 

SUBROUTINE  OPMi (NUMTAP)  OPM1  2 

C  OPM1  3 

C  H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  CECEM8ER  1978  OPMi  4 

C  OPMI  5 

Q44  *4  4  #*4444#  4444*4  44*4  4*  44  4*  44  44  44  44  444  4  4  44  4  4*44  *44  4  *  44  4  4*4444  4444**4  4  4  OPMI  3 

C  OPMI  7 

C  THIS  PROGRAM  INITIALIZES  AND  WRITES  HEADINGS  FOR  THE  OUTPUT  OPMI  8 

C  PROCESSOR.  THEN  IT  CALLS  THE  FIRST  PART  OF  THE  FARTICLE  ACTIVITY  OPMI  9 

C  MODULE  ( PA  Ml  OR  PAMlA)  TO  PRECOMPUTE  OATA  USED  BY  THE  SECOND  PART  OPMI  10 

C  OF  THE  PARTICLE  ACTIVITY  MODULE  WHICH  IS  CALLED  CY  0PM2,  OPMI  l.t 

C  OP HI  12 

C  PAM  1  IS  USED  FOR  CASES  WHERE  THE  FIREBALL  INTERSECTS  THE  GROUND  OPMI  13 

C  ANQ  PARTICLE  SIZE  DISTRIBUTION  IS  LOGNORMAL.  PAMlA  IS  USED  FOR  OPMI  14 

C  AIRBURSTS  AND  FOR  ARBITRARY  PARTICLE  SIZE-ACTIVITY  DISTRIBUTIONS.  OPMI  15 

C  UPMi  16 

0  44*V4»***4*44»*S-**4»44*4»44  444444  44  44444  44  444444444-444*4444444»4  44  4*44Qpm  ^7 

C  OPMI  18 


COMMON 

/CONOAT/ 

IC (20  ) 

,IHOB 

. IP  NCH 

.IPOUT 

,  OPMI 

19 

1ISIN 

.ISOUT 

.JPOUT 

. KPOUT 

,KT  AFE 

.LTAPE 

.OPMI 

20 

2  MARRAY 

.MBTAPE 

t  MXREQ 

.SD 

. IN  FAR 

OPMI 

21 

COMMON 

/MAPDAT/  CAYF 

.CUTMAP 

,OGX 

.OGY 

.IH  ,1 V 

,  DPMI 

22 

1  JC 

.NXMAP 

.NYMAP 

.NZ 

.QCUT 

.SSAM 

.  OPMI 

23 

2TGZ 

.XGZ 

.XI 

» X2 

»YGZ 

,XMAX 

,  OPMI 

24 

3XMIN 

.YMAX 

,YHIN 

,ZMIN 

OPMI 

25 

COMMON 

/PAROAT/ 

ASQ 

.  3SQ 

.COS  A 

»F 

.DPMI 

26 

1 G  AM  A 

.IP 

.PMAS(IOO) 

,PSIZ( 10 0  I 

•  KO (1  CO) 

,SIGXO(10C ) 

,  DPMI 

27 
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L, 


2SIGY0 (1QQ) ,  SIN  A 
3  Y  PR  MU  ,ZPAR  <10  0) 

COMMON  /RUNOAT/  C  ,CF6  ,FSUM  *  ICTR 

1MAPRUN  ,NE  ,NIJ  ,NORD  ,NREQ  tNTAS 

20PMI(m2l  ,T1  ,T  2  i WFH  AS  ( 2C 0  I 

COMMON  /FISHIN/  ABE GN ( 79 0 >, A8UNQ0 ( 70 0) t BRANCH!  130)  , CAPFI S , 

1  OCON (730)  ,IBRA,INUC,MAXNUC,MULT< 11) ,NUCLID  <7  uC) 

COMMON  /OUTPUT/  FIS N IM,  F  F ( 20  01  ,  FW,  NO STF. ,  JGC  t  MA  SCHN,  PS  (  200  J  * 
1  FMASS(200),DIAM(2Q0> 

COMMON  /UTILTV/  K CUT ,NPRNT < 15 ) 

INTEGER  FISSID 
LOGICAL  NPRNT 

DIMENSION  OETIO (12)  , OTMI D ( i 2) , NUMT AP (1 5 ) 

DATA  PROGRM  /6H  CPM1  / 


tTPAR (110)  ,XPAR( 100 )  * YP  AR (ICC )  ,YPRML 


*  ICTR 
tNTASK 


INCUCEC  ACTIVITY 


FORMAT ( 12A6)  QPM1 

FORMAT (PL1)  OPMl 

FORMAT  (A6,4X, 2F10. 3)  OPM1 

5  FORMAT ( /  30 X,  51HU238  INCUCEO  ACTIVITY  -  CAPTU RE-TO-FISSION  RATIC  OPM1 

1ISF7.3)  OPMl 

6  FORMAT (/  30X,  56HS01L  INCUCEC  ACTIVITY  -  NEUTRONS  EMITTED  PER  FISSOPMl 

1  ION  AREF7.3)  OP Ml 

7  FORMAT  <  /47X19HTYPE  OF  FISSION  IS  A6)  OPM1 

8  FORMAT  !  /21X55HTHE  CLOUC  REACHED  THE  SOIL  CONDENSATION  TEMPERAT UR 0PM1 

IE  OF  F7 « I*  hH  AT  F8.4.5H  SEC.)  OPM1 

9  FORMAT  (/  4  3X14HT0T AL  YIELO  IS , 1PE12 . 4 , 1  OH  KILCTCNS.t  OPM1 

1  /41X16HFISSION  YIELO  IS* 1PE12. 4, 10H  KILCTUNS.)  DPMI 

FORMAT ( //  4 IX t  33H****  SUMMARY  OF  RUN  IDENTIFIERS  ♦♦**/  41X,  DPMI 
1  13HOUTPUT  PROCESSOR  -  12A6,/  2fiX,  32HINITI ALI ZATION  AND  CLOUD  RISUPM1 


30)  t YP  AR  (ICC )  , YPRML  .  OPM1 

OPM1 

,  FSUM  t  ICTR  tOPMl 

,NREQ  tNTASK  , OPM1 

2C0)  UPM1 

3KANCH( 130) tCAPFIS,  OPM1 

UCLI D  (7  u  C  )  OP  Ml 

,  JGCtMASCHNtPS( 20Q) t  OPM1 

OPM1 
OPM1 
DPMI 
OP  Ml 

)  DPMI 

OP  Ml 
OP  Ml 
OPM 1 
OPM1 
OP  Ml 

-  CAPTURE-TO-FISSION  RATIC  OPM1 

OPM1 

-  NEUTRONS  EMITTED  PER  FISSOPMl 

DPMI 

DPMI 


2E  -  12A6/  38X,  22HD IFFUSIVE  TRANSPORT  -  12A6)  OPM1 

FORMAT (2014)  DPMI 

FORMAT (/22X77H****  THE  CONTROL  VARIABLE  ARRAY t  IC(J)t  WAS  GIVEN  TOPMl 
1HE  FOLLOWING  VALUES  ***♦/  19X,  2314)  DPMI 

FORMAT  (  /45X9HTHERE  ARE,l4,17H  PARTICLE  CLASSES)  OPM1 

FORMAT  (  /41X,  22H"lE  HEIGHT  OF  BURST  IS  ,  F9. 3,  8H  METERS.  )  DPMI 

FORMAT  (  /39X43HPPINTER  DESCRIPTION  -  CHARACTERS  PER  INCH/  OPM1 

1  42X,  10  Mr'O!. I ZCNTA  L 15 1 1  OX ,  10HVERTI  CAL  13)  OPM1 

FORMAT  (  15  X ,  4M-'ARt  8X,4HYPAR,  8X,  4HZPAR,  OX,  4HTPAR,  7X,  OPMl 

1  5HSIGXOt  7  X,  5HSIGY0t  8Xf  2HR0,  9X.  4HPSIZ,  8X,  4HPM AS // )  UPM1 

FORMAT (  1H1,  50X,  19H*  ********  *//55X,llH0  E  L  F  I  C//  OPMi 

1  12X1C1HT  HE  D  E  P  A  R  TOPMl 

2MENT  OF  DEFENSE  FALLOUT  PREDICTI  OOPM1 
3  N  S  Y  S  T  E  Mt//51X,19H*  ********  */ ///40X , 23HUUTPUT  PROOPMi 
4CESSOR  M00ULE///55XtHH  PREPARED  EY/45X,33HAT MU  SPHERIC  SCIENCE  ASSOOPM1 


VARIABLE  ARRAY  t  IC(J) t 
2314) 

PARTICLE  CLASSES) 


OPMl 
DPMI 
GIVEN  TOPMl 


UP  Ml 
OPMl 
OPMl 
OPMl 
OPMl 
OPMl 
DPMI 
OPMi 
TOPMl 
OOPM1 


5CIATES/  53X  t  1 4HBEDFCR0,  MASS.)  OPMl 

)  FORMAT (////45X38HLISTING  OF  FALLOUT  PARCEL  DESCRIPTIONS)  OPMl 

I  FORMAK//13X6HBLOCK  14)  DPMI 

3  FORMAT! 10X, 9E12. 4)  DPMI 

'  FORMAT ( 1 IX ,  43HNUMBER  OF  FALLOUT  PARCELS  IN  THIS  BLOCK  IS  14)  OPMl 

}  FORMA T ( 46H  NO  MAPS.  THIS  RUN  FOR  TAPE  IFOUT  PRINT  ONLY.)  DPMI 

40  FORMAT!  //25X,  63HTHIS  IS  AN  AIR9URST .  PARTICLE  ACTIVITIES  ARE  30PM1 

1 OMPUTEO  BY  PAMA  /  3QX,  11HSCALED  HOB=E12.5,  7H  (FEET))  OPMl 

L  FORMAT!  /43X,  42HS0IL  INDUCED  ACTIVITY  IS  NOT  ACCOUNTED  FOR)  OPMl 

l  FORMAT! 1H3 ,  11X,  53HFISSION  YIELO  IS  ACJUSTEO  eY  THE  FRACTION -DOW OPMl 

IN  FACT0RF8.5,  16H  FCR  SCALED  HUB  =  1PE11.4,  13H  FT  H*M-l/3))  UPM1 

OPMi 

NTASK=3  DPMI 

KOUT=ISOUT  DPMI 

00  50  1=1,200  DPMI 

50  PS ( I ) =0 . 3  DPMI 


DESCRIPTIONS) 


DPMI 
OPMi 
OPMl 
OPMi 
OPMl 
DPMI 
3  OPMl 
OPMi 
OPMl 


COMMENCE  READING  IPOUT  HCACEP.  DATA  OPMl 

READ  (IPGUT)FW,SSAM,SLDTHP,TMSQ,SO,W,HtI&HT,RHCF,RADMAX,ZMIN  OPMi 

RE AO  (IP0UT)XGZ,YGZ,1GZ  OPM1 

READ  (IPOUTI  (0ETID(J),J=1»12)  DPMI 

REAO  (IPOUT)  (DTMIQ(J), J*l,12)  DPMI 

READ  ( IPOUT) NOSTP  OPMl 

REAO  ( IPOUTMPS(J)  ,OIAM(  J)  ,FNASS(  J)  ,  J=l,NOSTR>  OPMl 

CONVERT  HEIGHT  IN  METERS  TC  H08  IN  FEET  OPMl 

HOB* H El GHT / • 30  46  OPMl 

COMMENCE  READING  CARO  INPUT  OPMl 

REAO  (ISIN.l) OPMID  OPMl 

READ  (ISIN,15)IC  OPMl 

REAO ( IS  IN*  3)NPRNT(6),KPRKT(7) .(NPRNTlI)  *1-9*13) ,NPKNT«15)  OPMl 

R£A0(ISIW,4)FISSI0,EMITN,CAPFIS  OPMl 

COPY  OUT  HEADER  AND  CRITICAL  OATA  OPMl 

WRITE  ( ISOUT *  20  >  OPMl 

WRITE  (ISOUT, 10)  OPMIO,OETIO*OTMIO  OPMl 

WRITE  (ISOUT, 16)  IC  OPMl 

WRITE  ( IS0UT,9)W,FW  OPMl 

WRITE  ( ISOUT, 7)FISSI0  OPMl 

WRITE  ( ISOUT* 1  A) HE IGKT  OPMl 

CHECK  SCALED  HOB  TO  SEE  IF  THIS  IS  AN  AIRBURST  OPMl 

IHOB*0  OPMl 

ZSCL* HO  B/W** (1. 0/3.4)  OPMl 

IF ( ZSCL  ,GE.  100.)  I HOB* 1  OPMl 

IF(IHOB  ,GT.  0)  GO  TO  75  OPMl 

COMPUTE  FRACTION-OOWN  ADJUSTMENT  FACTCR  FOR  FISSION  YIELD  OPMl 

IF ( ZSCL  .LE,  0.0)  GC  TO  60  OPMl 

ZSCM  *  HOB/W** (0. 3333333333)  OPMl 

FO  =  (0 .45345)**(ZSCM/65.Q)  OPMl 

WRITE(ISOUT,42)  FD*  ZSCM  ORM1 

FW=FW*FO  OPMl 

6C  IF( SO  ■ LE,  0.0)  GO  TO  75  OPMl 

IF(CAPFIS  ,GT.  0,0)  WRI TE < ISOUT , 5) CAPFIS  OPMl 

I F(  EMI TN  ,GT.  0.0)  WRITE(ISCUT,6)  EMI TN  OPMl 

IF  (  EMITN  ,EQ.  0.  u)  WRITE  (I  SOUT  *  41)  OPMl 

WRITE  ( ISOUT, 8)SL0TMP,TMS0  OPMl 

75  WRITE  ( I  SOL)  T  ,  1 7  )  NDSTfi  OPMl 

ICO  WRITE  (ISOUT, 21)IH*IV  OPMl 

IF(IC(2 ))501,501,5Uu  OPMl 

COPY  OUT  CONTENTS  OF  TAPE  IPOUT  OPMl 

500  NST  =  0  OPMl 

WRITE  (ISOUT, 29)  OPMl 

600  REAO  (IPOUT)NIJ  OPMl 

NST  =  NSTn  OPMl 

IF(  NX  J)  50  3,501,  50*  OPMl 

503  CALL  ERROR(PROGRM,-5C3, ISOUT)  OPMl 

50  4  REAO (IPOUT I (XPAR (I)  , VPA R (I ) ,ZPAR (I )  ,  TP AR (I ) , SI GXC ( I) ,S IG YO ( I) ,  OPMl 

1  RO(I),PSIZ(II ,PMAS(I),I=1,NIJ>  OPMl 

WRITE  (ISOUT, 30INST  OPMl 

WRITE  ( ISOUT, 37) NI J  OPMl 

WRITE  (ISOUT, 26)  OPMl 

WRITE (I SOUT, 3b) (XPAR  (I) , YPrtK(I) ,ZP Ak(I> ,TPAR(I ) , SI GX C ( I ) , SI GYO ( I », OPMl 
1  RO(I), PSIZ(I) ,PMAS (  ]),I=1,NIJ)  OPMl 

GO  TO  60C  OPMl 

501  REWINO  IPOUT  OPMl 

CHECK  IC(1),  A  POSITIVE  VALUE  TERMINATES  RUN  WITHOUT  PAM  OK  MAP  CALCS,  OPMl 

TF(IC(1)  .LE.  Q)  GO  TO  511  OPMl 

510  WRITE  (ISOUT, 39)  OPMl 

CALL  EXIT  OPMl 


ee 

39 

90 

91 

92 

93 

94 

95 

96 

97 
90 
99 

1J0 

101 

102 

103 

134 

135 

136 
107 
106 

109 

110 
11.1. 
112 

113 

114 

115 

116 
117 

lie 

119 

120 
121 
122 

123 

124 

125 

126 
127 
120 

129 

130 

131 

132 

133 
1j4 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 


155 


OOOOoOOOOO 


C  uPMl  148 

511  IF(  IHOB  .EQ.  C)  IF  < SC > 51 S . 515, 520  0PM1  m9 

WRITE<  ISOUT,49  )  Z SCL  DPMI  150 

515  CALL  PAM1A (FISSIO)  OPM1  151 

RETURN  OPM1  152 

520  CALL  PAMi  OPM1  153 

1  <H09  tSLOTMP  ,TNSC  ♦  M  ,£MITN,  FISSID  )  OPM1  154 

RETURN  DPMI  155 

EN0  UP Ml  156 


*  DECK,  0°M2  UPM2 

SUBROUTINE  OPN2 (OMAF,NMP)  0PM2 

UPM2 

H.  G.  NORMENI «  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1976  OPM 2 

0PM2 

««*»»*4*««**«»«*«»»*«**»«  *♦*****♦*#♦**#******♦♦»*•♦*•*♦******♦*#***  ***0PM2 

0PM2 

SECOND  HALF  OF  THE  CITPUT  PROCESSOR  UPM2 

THIS  SUBROUTINE  INITIALIZES  AND  CONTROLS  FOR  NAF  CALCULATIONS  0PM2 

0°M2 

¥*¥******¥**¥¥***''•¥¥***¥¥*•¥******¥«*¥**¥  ¥¥¥¥¥¥  ¥¥¥¥¥¥¥¥¥¥¥¥¥  **<M»****»(JPM2 

0PM2 


COMMON 

✓CONOAT/  IC ( 20 ) 

t IHOB  *  IP  NC  h 

1 1  POUT 

*  OP  M2 

13 

1ISIN 

« ISOUT  * JPOUT 

,KPOUT  »KT  AF  E 

,LTAPE 

,  OP  M2 

14 

2  MARRAY 

, MR TAPE  . RXREQ 

•  SO  » IN  FAR 

OP  M2 

15 

COMMON 

/MAPOAT/  CAYF  .CUTMAP 

,  JGX  tDGY 

»IH  .IV 

,  OP  M2 

16 

1  JC 

»  NXMAP  » NY  PAP 

,NZ  »OCUT 

,SSAM 

,  OPM2 

17 

2TGZ 

fXGZ  »X1 

*  X2  ,YGZ 

,  XMAX 

,  OPM2 

16 

3XMIN 

»  YMAX  » YMIN 

t  ZMI N 

OPM2 

19 

COMMON 

7RUN0AT7  C 

»CF  6  tFSUM 

.  I CTR 

,  UP  M2 

20 

1MAPRUN 

t  NE  »  NI J 

i NOP  0  » NR  EC 

,  NTASK 

,  UP  M2 

21 

2  0DM I D (1 

2)  ,T1  ,T2 

, WFM AS ( 200 ) 

UPM2 

22 

COMMON 

/DECAY/  IGC, JC.KOCS, TiNTER, TE XI T , T IME 

OP  M2 

23 

COMMON 

/OUTPUT/  FI  SMM»FP(  20C  )  » 

Fh»NDSTK. JGCtMASCHN,PS(20C)  . 

OP  M2 

24 

1  FMASSt  200> tDIAM (20  0  J 

UPM2 

25 

COMMON 

/UTILTY/  KCUT.NPRNT (15) 

UPM2 

26 

LOGICAL 

IGO » JD ,K  DO  5 ,  FPRNT 

OPM2 

27 

DIMENSION  CONTURT6),  OMAP(NMAP) 

UP  M2 

16 

DATA  BLANK/1CH  /  » PR0GRM7  6H  CP M2  /,  NUL/C/ 

OP  M2 

29 

DATA  QCUTAfCUTMPA/O.COOlt  0.01 

/ 

OPM2 

30 

OPM2 

31 

FORMAT 

(// 15X, 23HSUM  OF  MAP  OROINATtS  =  E13.6  ) 

UP  M2 

32 

FORMA  T  ( 1H1////54X,  HP*  *  *  »  * 

*) 

0PM2 

33 

F  ORMAT ( //  1 5X»  52HCC  f BINEO  GROUND  ROUGHNESS-iNSTFUMENT  RESPONSE  FA  OPM 2 
1CT0RF1Q.3,  5X,  14H ALTITUDE  OF  GZF1C.3,17H  METERS  ABOVE  MSL)  0PM2 

FORMA  T  (  7F 1!?  ,3)  OPM2 

FORMAT (32H  OUTPUT  PROCESSING  IS  COMPLETED.)  UPM2 

F0RMAT(1H1///39X27H*4**  OUTPUT  PROCESSOR  TASKI5»6H  **♦*)  OPM2 

FORMAT (///15X25HGRIO  LIMITS  AND  IN TERV ALS/2 0X4HX Ml N1 C X 4HX M AX1 0 X4HY UPM2 
1MIN1.1X4HYMAX10X7HDE  LT  A  X  »8X  7HDEL  TA  Y/15XF10.0,  4XF10.  J  ,  4XFlo  .6, 4XF10PM2 
25. J.5XF13. 2»5XF10. 2)  UP M2 

FORMAT (415*  4F10.0)  OPM2 

FORMAT (2 5HJ UN ACCEPT  ABLE  REQUEST  ...l4>  UP M2 

FORMA  T  (  ////15X  1 1 5HRECUES  T  NUMBER  I4///15X6HMAP  T  VPEI  3, 10X5HT.1  =  FlOPM2 
1%  2, 10X,  5HT2  =  F1C.2,15X,9HMASCHN  =  14//  15Xf6HCCUT=  ,  t-1  2.  5 , 10X  ,  OHOPM2 
2CUTMA  P=  ,C12.5>  OP*2 


COMPLETED. ) 
PROCESSOR  TASK 15  »6H 


*»•*) 


FAOPM2 
OPM  2 
UPM2 
UPM2 
OPM2 


156 
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41  FORMAT  <//2  fX»  19HMASCHN  SET  EQUAL  TOI5) 

UP  M2 

h7 

44  FORMAT(  8F10.3/A10) 

CPM2 

46 

45  FORMAT ( /  15X,  93PCCNTOURS  ARE  NOT  OETEkMINEO  BECAUSE 

THE  REQUESTEDOPM2 

49 

1  MAP  EXCEEDS  ALLOCATED  CORE  STORAGE  CAPACITY) 

0PM2 

50 

46  FORMAT  ( /15X ,  5bHTHc  SPECIFIED  MAF  GRID  INCREMENTS  PRODUCE  DISTCRTEUPM2 

51 

ID  MAPS) 

0PK2 

52 

47  FORMAT ( / 15X.  66HUND  ISTORTEO  MAPS  ARE  PF.OCUCED 

EY  THE 

GRID  I NCREMEN  0PM2 

53 

ITS  PRINTED  ABOVE) 

OP  M2 

54 

C 

OP  M2 

55 

IGO=.TRUE. 

GPM2 

56 

C 

OPMZ 

57 

COPY  IN  MA»  LIMITING  COORDINATES,  GRID  INTERVALS,  ANO  COMBINEO  GROUND 

OPM2 

56 

C  ROUGHNESS-SURVEY  INSTRUMENT  RESPONSE  FACTOR. 

0PM2 

59 

1191  REA0(ISIN, 9)XMIN,XMAX, YMIN,Y MAX, CGX.OGY, GRUFF 

OPM2 

60 

TF  ( GRUFF  .EQ.  3.0  GRUFF=i.O 

OPM2 

61 

1603  IFCAeS(OGX)  ♦  ABS  ( 0  G  Y  ))  12  Q ,  It  J  ,  1 21 

OPM2 

62 

120  WRITE  ( ISOU  T, 1 7  ) 

OPM2 

63 

REWIND  IPOUT 

0PM2 

o4 

RETURN 

OP  M2 

65 

C 

UPH2 

66 

COMMENCE  PROCESSING  FOP  MAPS  OF  THIS  DESCRIPTION 

OPM2 

67 

121  NTA  SK  =  NTASK*1 

UP  M2 

66 

FSUH=0 *  0 

OPM2 

69 

c 

0PM2 

7  C 

NRQ»0 

UPM2 

71 

CALCULATE  AOJUSTEO  MAP  GRIO  INCREMENTS  TO  ASSURE  AN 

UNCISTORTED  MAP 

CP  M2 

72 

NSP=  1 

uPM2 

73 

IFCOGY  , GT «  u.C)  GO  TO  1300 

UPM2 

74 

OGY=OGX*IH/IV/2.3 

OP  M2 

75 

1300  IFCOGX  .£Q.  2.0*IV*OGY/IH>  nsp=o 

0PM2 

76 

CALCULATE  NUMBER  OF  MAF  COPE  LOAOS  BEYOND  THE  FIRST, 

NZ. 

CPM2 

77 

NZ=  0 

OP  M2 

78 

NYMAP  =  <  YM AX  -  YMI N) /CGY 

OPM2 

79 

NOX=(XMAX-XMIN)/DGX 

OP  M2 

80 

NXMAP=NOX 

0PM2 

61 

NST  =  NMAP/NYMAP 

UPM2 

22 

IF <  NXMA P  ,LE.  NST)  GC  TO  1*,01 

UPM2 

63 

NXMAP=NST 

UPM2 

04 

1400  IF ( NXMA  P  ,LE.  0)  CALI  E RROR ( FROGRM , - 14 1 U , I SOUT ) 

OP  M2 

e  5 

NZ=  NOX/NXMA  P 

OPM2 

&  6 

1401  no  1121  J*l,NDSTfi 

UP  M2 

97 

WFMAS«J)=FMASSCJ) /GRUFF 

0PM2 

88 

IF  <  SO  .GT.  0.0)  WFMAS(J) =WFMAS ( J 1  *  3S  AM 

0PM2 

6* 

1121  CONTINUE 

OPM2 

5  j 

COcY  OUT  A  LOCAL  HEADING 

0PM2 

91 

WRITE  ( ISOUT . 23) NT  ASK 

0PM2 

92 

WRITE  (I  SOUT,  24)  XMIN  ,X  MA  X  ,  YMIN,  YPAX,  OGa.CGY 

0PM2 

93 

WRIT':  (ISOUT, 4)  GRUFF  ,ZMIN 

OPM2 

'J  4 

IF<NSP) 1123,1123,1122 

OPM2 

95 

1122  WRITE (ISOUT, 46) 

0PM2 

96 

GO  TO  1211 

UP  M2 

-3  7 

1123  WRITE (I SOUT, 47) 

jPM2 

36 

C 

OPM2 

i,  5 

1211  CONTINUE 

0PM2 

1-0 

C 

■VM2 

ltl 

1209  IF (FSUM  .NE.  3.0)  WP  ITE ( I SOUT, 2 ) F3UM 

CPM2 

1 .2 

IF ( N7  .GT.  0)  NXMAF=NST 

OPM2 

1  .3 

COPY  IMA  MAP  REQUEST 

OP  M2 

1.4 

RE  AO ( IS  IN, 32) NREQ, JC , ICONT , M ASCHN, T 1 , T 2 , CCUT ,C U T MAP 

0PM2 

1  5 

IF ( ICONT  .NE.  0)  REAO(ISIN,44  )  C3NTUR ,LRDL9L 

OPMZ 

1 . 6 

157 


IF { ICONT  .GT.  11  I FNCH=“ 1 

UP  M2 

ID  7 

IF ( JC  • EQ. 0) JC=i 

OPM2 

10« 

CHECK 

REQUEST  SPECIFICATIONS  ANO  Stf  DEFAULT  tfALUES  FCR  QCUT  AND  CUTMAP 

0PM2 

1)9 

IF ( NREQ  .  EQ.  0)  50  TC  1191 

OPM2 

IIP 

1213 

IF ( NREQ  .LE.  MXREQ) GC  TO  400 

OPM2 

111 

IRROR=l 213 

0PM2 

112 

40  3 

WRITE(JSOUT,33)NREQ 

OPM2 

113 

CALL  ERROR (PROGRM, IRROR»ISGUT) 

GPM2 

114 

GO  TO  1211 

0PM2 

115 

400 

IF C QCUT  .GT.  0.0)  GC  TO  50C 

0PM2 

116 

IF ( NREQ  .NE.  14)  GO  TO  402 

0PM2 

117 

IF ( Tl  .GT.  C.O)  GO  TO  404 

0PM2 

118 

OCUT  =  QCUTA*  2. C8E 1 2 

OPM  2 

119 

GO  TO  500 

UPM2 

12  J 

40  4 

QCUT  =  QCUTA*l.CE-4 

OP  M2 

121 

GO  TO  5 JC 

0PM2 

1  cl 

40  2 

IF ( NREQ  .LT.  2  .OR.  NREQ  .GT.  13  )  GO  TO  411 

OPM  2 

123 

QCUT=QCUTA 

OPM2 

124 

IF ( NREQ  .EQ.  3  .AND.  Tl  .GT.  1.0?  QCUT= QCUT*Tl ** (-1. 26) 

OPM  2 

lc5 

IF  ( NREQ  ,  G  £•  5  .ANO.  NREQ  .  LE.  10  .AND.  Tl  .GT.  1.  0)  QCUT=UCUT* 

UPM2 

126 

1 

3.846*Ti*M-0.26) 

UPM2 

127 

IF (  (NREQ.EQ.  6  .OR.  NREQ  .EQ.  7  .OR.  NREQ  .EQ.  1C)  .ANO. (Tl  .GT. 

1. 

0UPM2 

It  8 

1 

.AND.  T2  .NE.  0.0))  QCUT  =  QCUT  ♦  (1. 0- (Tl/T  2)  *M0 . 26)  > 

OPM  2 

129 

GO  TO  500 

UPM2 

130 

401 

QCUT=QCUTA*SSAM/<7. 0E9*GRUFF*FW ) 

OPM  2 

131 

500 

IF( CUTMAP  .GT.  0.0)  GO  TO  603 

OPM  2 

132 

IF ( NREQ  .NE.  14)  GO  TO  502 

OPM  2 

133 

IF (Tl  .GT.  0.0)  GO  TC  503 

0PM2 

134 

CUTMAP=CUTMPA*2.oBE13 

0PM2 

135 

GO  TO  600 

0PH2 

136 

503 

CUTMAP=CUTMPA*1. QE-4 

OPM2 

137 

GO  TO  600 

UPM2 

138 

502 

IF ( NREQ  .LT.  2  .OR.  NREQ  .GT,  10  )  GO  TO  501 

0PM2 

139 

CUTM AP=  CUT  MPA 

UPM  2 

1  4  J 

IF<  NREQ  .EQ.  3  .AND.  Tl  .GT.  l.O)  CUTM AP=CITMA P*T1** (-1. 26) 

OPM  2 

141 

IF<  NREQ  .GE.  5  .ANC.  NREQ  .LE.  10  .AND.  Tl  .GT  .  1. 0 > CUTM AP=CUTMA P* OPM2 

142 

1 

3.846*Tl**(-0.26) 

OP  M2 

143 

IF  <  (NREQ.EQ.  6  .OR.  NREQ  .EQ.  7  ,OR.  NREQ  .EG.  1 1)  .  AND  .  (  T  j. .  GT. 

1. 

0  uPM  2 

144 

1 

.AND.  T2  .NE.  0 . 0  i ) C UTM AP=C U TMA P* ( 1 .  t>  ( T 1/T 2) ** ( C . 2t ) ) 

0PM2 

145 

GO  TO  600 

OP  M2 

146 

501 

CUTMAP=CUTMPA*SSAM/ ( 7. 0E9*GRUFF*FW) 

0PM2 

147 

600 

IFtIHOB  .EQ.  0  .ANC.  SC  .GT.  0.0)  IF < NREQ - 14 ) 1 21 0. 69 j , 1 21 0 

OPM  2 

148 

601 

IF( NREQ  .NE.  9  .ANC.  NREQ  .NE.  10  .AND.  NREQ.  NE.  14)G0  Tu  121) 

OPM  2 

149 

IRROR=  601 

0PM2 

15  0 

GO  TO  403 

OPM  2 

151 

690 

IF(MASCHN.GT. 71. AND. MASCHN.LT. 162)G0  TO  1210 

OP  M2 

152 

WRITE (ISOUT»33)N RE Q 

GPM2 

153 

CALL  ERROR (PROGRM,  6°n,IS0UT) 

OP  M2 

154 

MA3CHN=95 

OPM.’ 

155 

WRITE (ISOUT ,41)MASCHN 

OPM2 

156 

COMMENCE  PROCESSING  FOR  THIS  MAP  REQUEST 

0PM2 

157 

CLEAR 

OUT  THE  OMAP  ARRAY 

OPM2 

158 

1210 

CLROT  =  0,9 

OP  M2 

159 

IF  (  (NREQ.EQ.  15)  .OP,.  (NREQ.EQ.  17)  )  CLROT =1.E30 

OPM2 

xe  ti 

DO  935  I=1,NMAP 

OPM2 

161 

935 

OMAP 1 I) = CLROT 

OP  M2 

162 

COPY  PAST  IPOUT  HEADER  DATA  TO  POSITION  TAPE  AT  START  CF  PARCEL  DATA 

OP  M2 

163 

REWIND  IPOUT 

OP  M2 

164 

OO  1214  1=1,6 

O  P"2 

165 

1214 

REA  O ( IPOUT ) 

OPM2 

166 

158 


o  O  o 


NREQ  .EQ.  10)  NPRNT (15)= 
,  NR'IQ  .NE.  4)  GO  TC  980 


NRQ=NRQU 

IF<NRQ  .NE.  1)  MRI TE ( I SOUT , 3) 

WRITE  (IS0UT.34) NRQ , NREQ , Tl , T2 , M ASCHN  ,QCUT,CU 

IF ( ICONT  .NE.  0  .ARC.  N2  .GT.  0)  WRITEdSOUf 

MAPRUN=C 

FSUM  =  0.0 

JGO  =  l 

JO*  , TRUE, 

K003=. FALSE. 

FISNUM=FW*i.45E15 

NORD=l 

C*l.  0 

CF6*i. 1 

IF<  NREQ  .EQ.  9  .OR.  NREQ  .EQ.  10)  NPRNT(15)= 

IF1NREQ  .NE.  13  .ANO.  NREQ  .NE.  4)  GO  TC  980 

Tl=TiM.QE-6 

T2=T2*1.0E-6 

GO  TO  965 

980  Tl  =  Tl*3  6li0  •  ♦  TGZ 
T2=T2*36.)(J.  ♦  TGZ 
TIME=Tl-TGZ 
TENTER=TIME 
TEXIT=T2-TGZ 

C  NREQ  -  It  2,  3,  4«  5,  6,  7  *  8,  9,10,11,12,13, 

985  GO  TO  (9ut70,79,70,69,68,73,7a,  78,73  ,8l ,60  ,6 j, 

68  CF6=CF6M1.0  -  ( TIME/TEXIT ) *  * ( 0  .26 ) > 

69  CF  6=  32.  3344*CF6*  <T I  RE )♦* (-0 . 26 ) 

7n  TINE  =  36Q'J.0 

GO  TO  79 
71  JGO=2 

FISNUN=FISNUM*i.E*4 

IF (  IH09  .GT.  C  )  CALL  ERR0R(  PROGRM,  -71,  IS 
GO  TO  79) 

73  KOO  S=  •  T  RUE . 

76  JO=. FALSE. 

FISNUM=FISNUM/3690 , 

79  CONTINLE 

IF (  JH OB  .EQ.  0  .ANC.  SO  .GT.  3.0  )  GO  TO  79 
CALL  AM2A 
GO  TO  8  ) 

790  CALL  PAH2 
6C  NOR  0=N0R0* 1 

90  NORD=MAX1( NORO, NORO ♦NREQ-ln) 

************************************  ************** 

Xl=  XMIN 

X2=Xl«-NXrtAP*DGy 

ICTR=P 

IF { NZ ) 2J3, 204,207 
203  CALL  ERR OR (PROGRM  ,-2C3,ISOUT) 

COMPUTE  A  SINGLE  CORE-LOAD  MAP 
2C4  KTA  PE  =  I POU T 

CALL  GOGO(OMAP.NMAP) 

9EWIN0  KTAPE 

IF< (NREQ, NE. 15) .ANC.  (NREQ. NE. 17) )  GO  TO  305 
00  302  IMAPs-l.NMAP 

IF ( ONAP (IMAP) . GE. 1. E30)  OMAP( IMAF) =0.0 
302  CONTINUE 

305  IF ( ICONT  .NE.  0  .ANO.  CROldL  .NE.  3L  ANK) CALL  C 


TO  305 


QPM2 

OPM2 

TRAP  OPM2 

,45)  OP  M2 

OPM2 
OPM2 
OP  M2 
0PM2 
OP  M2 
OPM2 
0PM2 
OPM2 
0PM2 

• TPUE,  OPM2 

OPM  2 
UP  M2 
OPM2 
OPM2 
OPM2 
OPM2 
OPM2 
OPM2 
OPM2 

14,15,16,17,18  0PM2 

71, 80, 80, 80, 80),  NREQ  UP  M2 

0PM2 
OPM  2 
OPM2 
OPM2 
OPM  2 
QPM2 

CUT  )  OP M2 

OPM2 

OPM2 

OPM2 

OPM2 

0PM2 

0  0PM2 

OPM2 
OPM2 
OPM2 
OPM2 
OPN2 
OP  M2 

********************  Qp  M2 

0PM2 
OP  M2 
0PM2 
OP  M2 
OPM2 
0PM2 
OPM2 
0PM2 
OP  M2 
OP  M2 
OPM2 
0PM2 
OPM  2 
0PM2 

ONTOR(CONTUR,CROLBL, 0PM2 


1  OMAPtNHAP) 

CALL  MAP  COMAPf  NM AP) 

GO  TO  1211 

COMPUTE  A  MULTIPLE  CORE-LCAD  MAP 

207  REMIND  JPOUT 
REWIND  KPOUT 
KT  APE=I POUT 
LTA  P£=J  POU  T 

CALL  GOGO(OMAP,NMAP> 

REMIND  KTAPE 
HRITE(LTAPE)NUL 
REMIND  LTAPE 

IP ( (NRcQ.NE.l 5 ) • AND  *  (NREQ.NE. 17) )  GO  TO  306 
00  3.16  IMAP=lf  NMAP 

IF ( OMAP  < IMAP) .BE.l. E20)  0 MAP (IMAP) ~0 • 0 
306  CONTINUE 
308  CALL  MAP ( OMAP, NHAP) 

OO  220  INOEX=i,NZ 
CLEAR  OUT  THE  OMAP  ARRAY 
CLROT=  0  •  ? 

IF( (NREQ.EO.15) .OR  .  (NREQ. EQ  .  17) )  CLROT  =  l.t3  0 
DO  732  IMAPal »  NMAP 
702  OMAP(IMAP)=CLROT 

IF ( MOD ( INDEX. 2 ) • EQ  .  1)  GO  TO  206 

KTAPE=KPOUT 

LTAPE=JPOUT 

GO  TO  209 

208  KTAPE=JPOUT 
LTAPE=KPOUT 

209  ICT R=INQEX 

IFdNOEX  .EO.  NZ)  NXMAP=NOX  -  NZ*NXMAP 
X1=X2 

X2=Xl+NXMAP*OGX 

210  CALL  GOGO(OMAP.NMAP) 

REWIND  KTAPE 

WRITE (LTAPE ) NUL 
REWIND  LTAPE 

IF( (NREQ.NE.15) . ANC.  (NREQ.NE.17) >  GO  TO  220 
DO  215.  IMAP=1,NMAP 

IF (OMAP (IMAP) .GE.1.E3G)  OMAP(IMAF) -0*0 
215  CONTINUE 
220  CALL  MAP(OMAP.NMAP) 

GO  TO  1211 
END 


OPM2  227 
OPM2  228 
OP M2  229 
0PM2  230 
OPM2  231 
OP M2  232 
OP M2  233 
0PM2  234 
OP M2  235 
OP M2  236 
OPM2  237 
UPM2  238 
UPM2  239 
0PM2  240 
OPM 2  241 
0PM2  242 
OPM2  243 
OPM2  244 
0PM2  245 
OP  M2  246 
OPM2  247 
0PM2  248 
0PM2  249 
OPM2  250 
UPM2  251 
OPM 2  252 
OPM 2  253 
OP  M2  254 
0PM2  255 
UPM 2  256 
0PM2  257 
0PM2  258 
0PM2  259 
OPM2  i!£C 
UPM 2  261 
0PM2  262 
OP M2  263 
0PM2  264 
UPMZ  265 
UPM2  Z 66 
0PM2  267 
0PM2  268 
UP M2  269 
UP  M2  2  70 


160 


<r-  c* *-?  r,  o  o  o  o  o  o  o  o  o  o 


*0£CK,  PAMiA  P  AMI  A  i 

SUBROUTINE  PAMIA (FI SSIO)  P AMI A  2 

PA  Ml A  3 

H.  G.  N'jRMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  JANUARY  1979  PAM1A  A 

PA  Ml  A  5 

************************  «****.***♦.,«■********, .**#***********************PA 

PAM1A  7 

PART  1  OF  THE  AIRBURST  ANO  USER  SPECIFIED  SI  ZE  -  ACT  I VI  T  Y  PARTICLE  PAM1A  8 

ACTIVITY  MODULE  PAM1A  9 

PAM1A  10 

MATCHES  THE  -ISSION  TYPE  INDICATOR*  F1SSID*  WITH  THE  STORED  TAB  LEPAM1A  11 

OF  TYPES  AND  STORES  THE  ACTIVITY  K  FACTOR  (R- F** 2) / ( HR-KT )  PAM1A  12 

IN  CAYF.  P AMI A  13 

PAM1A  1 A 

*******************************  *******.■,(*  ******************************  pAM  i  A  15 


PAMIA 

16 

COMMON 

/MaPOAT/  CAYF 

,CUTMAP 

>  DGX 

,  DG  Y 

,IH  ,IV 

, PAMIA 

17 

J  JC 

, NXM  AP 

, NYMAP 

♦  NZ 

,  GC  J  T 

,  SShM 

, PAMIA 

18 

c  TGZ 

,  XG7 

»X1 

,X2 

,YGZ 

,  X  MAX 

, PAMIA 

19 

3HHIN 

SVMAX 

»YMIN 

,ZMIN 

PAMIA 

20 

COMMON 

/UTILTY/  KOUT 

tNPRNT (15) 

PAMIA 

21 

INTEGER 

FlSSIOfFISTP 

PAMIA 

22 

LOGICAL 

HPRNT 

PAMIA 

23 

DIMENSION  FISTPi  7)  , 

FK  <  7) 

PAMIA 

24 

OAT  A  PROGRM  /  6HPAM ABi  / 

PAMIA 

25 

DATA  FICTP 

PAMiA 

26 

1/  6HU233KE,6HP239HE »eHP239FI,6HU235HE,6HU235FI ,6HU238TN, 6MU238HE  /PAMIA  27 
DATA  FK  PAM1A  28 

1/  £.30lOE9,6.083QE9,6.9733E9,7.291iE9,7,8643E9,7.9407E9* 8.2111E9  /PAMIA  29 

C  PAMiA  30 

1100  FORMAT(///10::,  45HFISSI0  DUES  NOT  MATCH  KITH  ANY  AVAILABLE  TYPES  PAMIA  31 

G  PAMiA  32 

00  IT U  1=1,7  PAMiA  33 

IF  St"  I  SSIO  .EQ.  FISTF(I))  GO  TO  203  PAMiA  34 

103  CONTINUE  FAhlA  35 

WRITE (  KOUT  ,1100  )  PAMIA  26 

CALL  ERROR (  PROGRM,  -1QC,  KOUT)  PAMIA  37 

200  CAYF  =  FK( I )  PAMIA  3o 

RETURN  PAMIA  39 

END  PAMIA  A P, 


ooooooooooooooooooooo 


*  DEC  K»  PAM  2 A 

SUBROUTINE  PAM2A 

H.  G.  NORM ENT ,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  l9?S 

PART  2  OF  THE  AIR8URST  ANO  USER  SPECIFIED  SI ZE -ACT  IV IT Y  PARTICLE 
ACTIVITY  MODULE 

COMPUTES  THE  PARTICLE  ACTIVITY-SIZE  ARRAY  FP<  ),  FP(I>  CONSIST 
OF  THE  EXPOSURE  RATE.  FOR  ACTIVITY  f,  jN  CENT  RATE  D  IN  ONE  SQUARE 
METER  OF  GROUND  SURFACE,  ASSOCIATE^  WITH  PARTICLES  OF  THE  ITH 
SIZE  CLASS. 


JO 

KOOS 

CAYF 


(LOGICAL)  TRUE-COHPUTE  EXPOSURE  RATE  AT  TIME  TIME 
FAlSE-COMPUTE  dose 

(LOGICA  l)  TRUE-COMPLTE  OOSE  FROM  TIME  TENTER  TO  TEX 
FALSE-COMPUTE  OOSE  FROM  TIME  TENTER  TO  INF 
ACTIVITY  K  FACTOR  (R-M**2/HR-KT> 


COMMON  /DECAY/  I  GO, JC, KDOS, TENTER , TE XI T , T I  ME 

COMMON  /MAPOAT/  CAYF  .CUTHAP  ,DGX  ,DGY  ,IH  ,IV 

i.JC  »  NX  MAP  , N YMAP  ,NZ  ,GCUT  ,SSAM 

TGZ  » XGZ  ,X1  ,X2  » YG  Z  ,XMAX 

.  XMIN  , YM AX  ,  YMIN  ,ZMIN 

COMMON  /OUTPUT/  FI S NUM ,F F ( 2 0 U ) , F W, IT AB , JGQ , MAS CHN, PSI ZE ( 2 D J ) , 

1  FMASS<Z30),PACT(200) 

COMMON  /UTILTY/  KCLT.NPRNT (15) 

LOGICAL  IGO.JO.KDOS.NPRNT 

1000  FORMAT (  1H1,  5X,  53 HT ABLE  OF  TOTAL  ACTIVITY  IN  EACH  PARTICLE  SIZ 
1CLASS  -//  XI6X,  5HPSIZE,  10X,  2HFP,  5X  ) ) 

2000  FORMAT (  8(1PE14.4)> 

3000  FORMAT (  iHCtl3X,  11HK  FACTORS  10X,  lPtll.4, 

1  17H  (R-M**2)/(HR-KT),  10X,  1PE11.4,  18H  (R-M 1**2 ) / ( HR- XT) ) 

A  r  CAYF  *  FW 

IF (  JO  )  GO  TO  100 

A  =  32.3344  *  A  /  T  ENTER**  (  0 . 26) 

IF (  KDOS  )  A  =  A* (1  •  C  -  (TENTER/TZXIT) **  (0. 26) ) 

GO  TO  203 

100  I F(  TIME  .EQ.  36  00.  )  GO  TO  200 
A  =  A  *  (3600  ./TIME) ** f 1 .26) 

200  CONTINUE 

DO  300  1  =  1 1 1T AB 
300  FP  ( I )  =  A*  FMASS(I) 

IF  (  NPRNT  (15  ■  )  RETURN 

NTA8=IT mB/4 

IF  (  N TAB  *4  .LT .  ITA3 ) NTAB=NTA8*i 
WRITE (  XOUT  ,1300  ) 

WRITE  CKOUT,2000) (PSIZE(I) ,FP(I) .PSIZE (I*NTAP)  ,FP(I*NTAB), 

1  PS  I  ZE  ( I  +2*  NTA  B)  ,FF  (I+2*NTAB>  .PSIZE  ( I*.J*NTABi  ,  FF  !I  +  3*NTAtl)  ,1=1, 

2  NT  AB ) 

CAYF A  =  C A YF  *3„861E~7 
WRITE(KOUT  »  30  0  0 ) C AY  F  .CAYF A 
RETURN 
END 


PAN2A 
PAM2A 
PAH2A 
PAM2A 
PAM2A 
**  PAM2A 
PAM2A 
PAM2A 
PAM2A 
PAM2A 
S  PAM2A 
PAM2A 
PAM2A 
PAM2A 
PAM2A 
PAM2A 
PAM2A 
IT  PAM2 A 
.  PAM2 A 
PA  M2  A 
PAM2A 
**  PAM2A 
PAM2A 
PAM2A 
, PAM2 A 
, PAM2A 
, PAM2A 
PAM2A 
PAM2A 
PAM2A 
PAM2A 
PA  M2  A 
E  PAM2A 
PAM2A 
PAM2A 
PAM2A 
PA  M2  A 
PAM2A 
PAM2  A 
PAM2  A 
PA  M2  A 
PAM2A 
P  'M2A 
PAM2A 
PAM2A 
PAM2A 
PAM2  A 
PAM2A 
PA  M2  A 
PAM2A 
PAM2  A 
PAM2  A 
Pm  M2  A 
PAM2A 
PAM2A 
PA  M2  A 
P  m  H  2  A 
PA  M2  A 
PAM2A 


1 

2 

3 

4 

5 

6 

7 

8 
9 

iu 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 
c.2 

33 

34 

35 

36 

37 
33 

39 

40 

41 

42 
m3 

44 

45 

46 

47 

48 

49 
5  0 

51 

52 

53 

54 

55 

56 

57 
53 
59 


102 


oooor,  ooooooooooonoor.  ooooonoooooooooooooooooooo 


♦OECK*  PCHECK  PCHEC 

SUBROUTINE  PCHECK4 I JIN, OMAP ,NMAP>  PCHEC 

PCHEC 

H.  G.  NORMENT,  ATMOSPHERIC  SCIENCE  ASSOCIATES  -  DECEMBER  1978  PCHEC 

PCHEC 

***»*#««.»*»  *«»«#»**»*»*  «+***#♦*  •♦♦♦♦•♦••♦•♦♦*•♦  ♦  ♦♦♦q ****♦♦*#*•  ********  PCHEC 

PCHEC 

THIS  SUBROUTINE  DETERMINES  THt  TYPE  OF  MAP  REQUESTED  ANO  PCHEC 

IT  INITIALIZES  FOR  THIS  MAP.  FOR  EACH  PARCEL  IN  THE  DATA  BLOCK  PCHEC 


OF  ITS  CONTRIBUTION  ELLIPSE  AND 
WHETHER  IT  WILL  CONTRIBUTE  TO 
OR  NOT.  IF  A  PARCEL  CONTRIBUTED 


THIS  SUBROUTINE  DETERMINES  THt  TYPE  OF  MAP  REQUESTED  ANO  PCHEC  8 

IT  INITIALIZES  FOR  THIS  MAP.  FOR  EACH  PARCEL  IN  THE  DATA  BLOCK  PCHEC  9 
IT  COMPUTES  THE  BQUNORIES  OF  ITS  CONTRIBUTION  ELLIPSE  AND  PCHEC  10 

IT  LABELS  IT  ACCORDING  TO  WHETHER  IT  WILL  CONTRIBUTE  TO  PCHEC  11 

SUBSEQUENT  MAP  CORE  LOAOS  OR  NOT.  IF  A  PARCEL  CONTRIBUTED  TO  PCHEC  12 

THE  CURRENT  MAP  CORE  LOAC  ,  SUBROUTINE  CALC  IS  CALLED.  PCHEC  13 

PCHEC  14 

«#•»***  •**«*•******»*«'»  «**»***•  •••♦♦♦•♦•  «*  ♦  •  **♦♦»•#.»■*♦•  **•*•**♦.  ♦*****»PQ  HE  C  15 

PCHEC  16 

.*«.*•**««**«•«»•«**«•••♦.♦*♦♦♦♦♦'»♦  GLOSSARY  ♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦♦•♦♦•♦♦PCHEC  17 


OR  NOT.  IF  t 
,  SUBROUTINE 


CALLEO. 


J 

KTRCIP1 


YPRMU 

XPRMU 

XPRML 

YPRML 

ASQ 


.»♦♦♦♦♦  i*.*******  GLOSSARY  ♦•♦•♦♦•♦•♦♦♦♦♦♦♦♦♦♦♦♦•♦♦•♦♦PCHEC 

PCHEC 

PARTICLE  SIZE  CLASS  INDEX  PCHEC 

INDICATES  WHETHER  OR  NOT  THE  PARCEL  IS  TO  BE  PCHEC 

CONSICEREO  IN  SUBSEQUENT  MAP  CORE  LOADS  -  -  PCHEC 

0  -  CONSICER  PARCEL  SUBSEQUENTLY  PCHEC 


1  -  REJECT  PARC  tL  FOR  FURTHER  USE 
UPPER  Y  CO CROINATE  LIMJ.T  FOR  PARCEL  CONTRIBUTION 

UPPER  X  COORDINATE  LIMIT  FOR  PARCEL  CONTRIBUTION 

LOWER  X  COORDINATE  LIMIT  FOR  PARCEL  CONTRIBUTION 

LOWER  Y  COORDINATE  LIMIT  FOR  PARCEL  CONTRIBUTION 

SQUARE  CF  SEMI-AXIS  A  OF  THE  PARCEL  CONTRIBUTION 
LIMIT  ELLIPSE 

SQUARE  CF  SEMI-AXIS  3  OF  THE  PARCEL  CONTRIBUTION 
LIMIT  ELLIPSE 

SIN  CF  THE  ORIENTATION  ANGLE  OF  THE  A  AXIS  CF 
THE  PARCEL  CONTRIBUTION  LIMIT  ELLIPSE 
COSINE  CF  THE  ORIENTATION  ANGLE  OF  THE  A  AXIS  OF 
THE  PARCEL  CONTRIBUTION  LIMIT  ELLIPSE 
L0G4BASE  E)  OF  THE  RATIO  OF  THE  GAUSSIAN  PARCEL 
CONTRIBITI  ON  DISTRIBUTION  MODE  VALUE  TO  P  Vr 
COUNT  CF  AVAILABLE  PARCEL  STORAGE  LOCA  t  IN 

CORE.  THIS  IS  THE  NUMBER  CF  PARCELS  J  D 

IN  PCHECK. 

A  BLOCK  COUNT  OF  DATA  STOftEO  ON  TAPE  ANC/jR  IN  COKE 
MAGNITUDE  41. E.  INTEGRATED  VALUE}  OF  A  PARCEL 
PROPERTY  TO  BE  DISTRIBUTED  ON  THE  HAP 


PARCEL  CONTRIBUTION 


AXIS  OF 


AXIS  OF 


ALSO  SEE  OPM1  GLOSSARY 


PCHEC  19 
PCHEC  20 
PCHEC  21 
PCHEC  22 
PCHEC  23 
PCHEC  24 
PCHEC  25 
PCHEC  26 
PCHEC  27 
PCHEC  28 
PCHEC  29 
PCHEC  30 
PCHEC  31 
PCHEC  32 
PCHEC  33 
PCHEC  34 
PCHEC  35 
PCHEC  36 
PCHEC  37 
PCHEC  38 
DGHEC  39 
PCHEC  40 
PCHEC  41 
PCHEC  42 
PCHEC  43 
PCHEC  44 
PCHEC  45 


PCHEC  46 

«*«#*.♦♦♦♦♦♦♦♦♦  ********♦♦#»♦♦♦♦♦♦♦•♦♦••♦♦♦♦♦♦•♦♦♦♦♦♦♦•♦♦♦♦♦♦♦*♦♦♦•♦♦♦  ♦♦PCHEC  47 

PCHEC  48 


COMMON  /CONDA  T  t 

I  C  4  2  J  > 

,  IHOB 

. IP  NCH 

,  IPOUT 

, PCHEC 

49 

1ISIN  .ISOUT 

,  JPOUT 

.KPOUT 

. KT APE 

»  LT  A°£ 

?  PCHEC 

50 

2  MARRAY  . MBT  APE 

. MXREQ 

.SO 

. IN  F  AM 

PCHEC 

5 1 

COMMON  /MAPOAT /  CAYF 

.CUTMAP 

»DGX 

tOG  Y 

» I H  ,IV 

.PCHEC 

52 

1JC  , NXMA  P 

*  NY  MAP 

,NZ 

»QCUT 

»  SS  AM 

,  PCHEC 

53 

2TGZ  . XGZ 

.XI 

»  X2 

,  YGZ 

,XHAX 

, PCHEC 

54 

3XMIN  . YMA  X 

» YMIN 

,ZMIN 

PCHEC 

55 

COMMON  /PAROAT/ 

ASC 

» 3SQ 

,COSA 

.F 

.PCHEC 

56 

1  GAMA  .KTR41J0) 

,PMAS  41u3) 

fPSIZ 4 Iflj) 

»RO 41001 

.SIGXO4100  > 

, PCHEC 

57 

2SIGY0 ( 1 C  3  » »  SI NA 

,TP  AR  4  ltiO  ) 

.XPAR4 1JC) 

,YP AF 41C0) 

. YPRML 

.PCHEC 

58 

3  YPRMU  .ZFAR41C0) 

PCHEC 

59 

COMMON  /RUNOAT/ 

C 

.  CF6 

»  FSUM 

-  ICTR 

.PCHEC 

6C 

163 


o  no  oo  on  ooooo  noon  noon 


IMAP RUN  ,NE  » NI J  ,NORD  ,  NREG  , NT  ASK 

ZOPNIOUZ)  ,T1  ,T2  , WFMAS  <  2 jii ) 

COMMON  /OECAYV  I  GO, JC »K0 (S , TENTER, Tt XI T  ,  TI ME 

COMMON  /OUTPUT/  FISMJM,FF(23u)  .FW.NOSTF  ,  JG  C,  MA  SC  HN ,  PS  (20  J  )  , 

1  FMASS<2J0> ,DIAMC200) 

DIMENSION  OMAP(NMAP) 

logical  igo,jd,koos 

DATA  PR0GRM/6HPCHECK/ 

NE=T 

IF (  IJIN.EQ.GI  GO  TO  5C 
J=1 

IJIN=C 

NDST°1=  NOST  R*-l 
5  C  00  77 7  IP=1,NIJ 

DETERMINE  IF  THE  DEPOSIT  INCREMENT  IS  GRCUNOfcD 
IF « (7PAR(IP)-ZMIN> .GT.1C.0)  GO  TO  200 

NREQ  -  1,  2,  3,  A,  5,  6,  7,  a,  <3,  It,  11,  12,  13,  14, 

75  GO  TO (1 31, 120, 10 3, U 4,1 05, 106, 12w,120, 115,106, 101,112,113,120, 
1  1  11,  lbl ,  10 1  >  ,  N  FEQ 

NREQ  -  16,  17,  13 

1C1  COUNT  OF  GRGUNOED  WAFERS,  OR  MASS  DEPUSIIED,  OR  TIME  OF  ONSET 
OR  CESSATION,  OR  SMALLEST  jk  LARGEST  PARTICLE  SIZE. 

101  F=PMAS(IP» 

GO  TO  130 

1C' 3  OQ SE  RATE  AT  TIME  Tl  SECONOS 
1C 3  IF<TPaR<IPJ  -  Tl) 120  ,12a ,200 

104  H*i  HR  NORMALIZED  DOSE  RATE  RESULTING  FR  CM  PARTICLES  IN  THE  SI 
RANGE  Tl  TO  12  MIC FO PET  EPS 

104  IF(PSIZ(IP)  ,GE.  Tl  .ANC.  PSIZ(IP)  .  L  t .  T2>  GC  TO  120 
GO  TO  2  3  i 

105,  106  OUSE  ACCUMUtATEC  FROM  TIMES  Tl  TO  INFINITY  CR  T2. 

106  IF(TPAR(IP)  .GE.  T  2 )  CO  TO  2J0 

105  IF (TPAR ( IP)  .GE.  Tl)  GO  TO  lu7 
TEN  TER"  Tl-T  GZ 

C=CF6 
GO  TO  12? 

1C  7  TENT£R=TPAR(IP)-TGZ 

IF(NRFQ  .EQ.  9  .OR.  NREQ  .El.  1J>  GO  TC  121 
C=  3  2.  33  44* (TENTER) ♦♦ (-0.26) 

I F ( NREQ  .EQ.  6)  C=C’I1.C  -  (T ENTER/T E X I T > ♦* ( l .  2 6 ) ) 

CO  TO  iza 

112  TOTAL  PARTICLE  MASS  CEPOSITED  BETWEEN  TIMES  U  AND  12  SECONOS 

112  IF (TPAR  (IP)  .GE.  Tl  .AND.  TPAK(IP)  .LE.  T2)  GC  TO  111 
CO  TO  260 

113  MASS  FROM  PARTICLES  IN  THE  SIZE  RANGE  Tl  TO  T?  MICROMETERS. 

113  IF (  PS IZ  (IP)  .GE.  Tl  .ANC.  PSIZTIPI  ,L£.  T2)  GC  TO  lOi 

GO  TO  200 

120  FINO  INOEX  OF  “ARTICLE  SIZE  CLASS 

121  IFTICTR  .NE.  0)  GO  TC  122 

121  IF  ( ASS  ( PSIZ  (IP)  -  PS<J))  .LT.  1.1E-S)  GO  TO  12  5 


5  PCHEC  61 
PCHEC  o2 
PCHEC  63 
PCHEC  64 
PCHEC  65 
PCHEC  66 
PCHEC  67 
PCHEC  66 
PCHEC  69 
PCHEC  70 
PCHEC  71 
PCHEC  72 
PCHEC  73 
PCHEC  74 
PCHEC  75 
PCHEC  76 
PCHEC  77 
PCHEC  78 
PCHEC  79 
15,  PCHEC  8  0 
101, PCHEC  61 
PCHEC  82 
PCHEC  33 
PCHEC  64 
PCHEC  85 
PCHEC  86 
PCHEC  87 
PCHEC  08 
PCHEC  69 
PCHEC  90 
PCHEC  91 
PCHEC  92 
ZE  PCHEC  93 
PCHEC  94 
PCHEC  95 
PCHEC  96 
PCHEC  97 
PCHEC  *6 
PCHEC  99 
PCHEC 1 j  0 
PCHEC 1 w 1 
PCHEC1I2 
PCHEC1J3 
PCHEC1L4 
PCH£Ci:5 
PCHtCl j6 
PCHECi*  7 
PCHEC1 18 
PCHEC1C9 
PCHE^llO 
PC HEClil 
PCHEC112 
PCHECli 3 
PCHEC 1 14 
PCHEC115 
PCHECllb 
PCHtC117 
FCHEC118 
PCHEC119 
PCHEC120 


J  =  J  +  1 

PCHtCIZi 

IF< J.LE.NQSTRIGO  TO  121 

PCMEG122 

CALL  ERROR (PROGRM  ,-120,ISOUT) 

PCm£C12  3 

122 

DO  123  1=1 tNDSTR 

PCHEC12** 

K=NOSTPl-I 

PCHttl-5 

IF ( OI AH (K)  .GE.  PSI Z  IIP) 1  GO  TO  12* 

PCHEC126 

123 

CONTINUE 

m*h£l127 

CALL  ERROR (PROGRM* -123*1  SOUT) 

PChElIE? 

124 

J=K 

F  C Me  0129 

125 

IF ( NREQ  .EG.  9  .OR.  NREQ  .EQ.  13)  CALL  PAH2 

PChECUL 

IF  (  NREQ  •  NE  •  14)  GO  TO  130 

PCh£  Cl S  1 

F-FP (  J  )*PHAS(IP)/FMASS<  J  1/SSAM 

PC.HEG132 

GO  TO  100 

PChLCI 33 

130 

F=FP {  J  )*PHAS(IP)/WFHAS<  J  )  *  C 

PCMECl 34 

c 

PJHtCl 35 

c 

4MHMP 

•*PoHEC136 

c 

PCMEC13T 

100 

CONTINUE 

PCHEC138 

c 

PwHECl 39 

c 

COMPUTE  GAMA  AND  DETERMINE  THE  LIMITING  C  OCROI  NA  TE  b  CF  THE 

P  3h£o  !•*  T 

c 

PARTICLE  CONTRIBUTION  ELLIPSE 

PCHEL141 

c 

PCHEC1W2 

IF(F.LT.QCUT)  GO  TO  200 

PCHEL1-.3 

GAMA  =  ALOG<F/SIGXC(IP)/SIGYO(IP)/QC.UT/E. 28213531) 

PCmEL1*0 

IF(GAMA.LT.O.P)  GO  TO  2P0 

PCHEC1.5 

COS A=COS ( RO  < IP ) ) 

PCHtCl<»6 

SINA=SIN(RC(IP)  1 

FCHt0147 

ASQ  =  2.  3*GAMA*SIGX0(IP)*#2 

PCh£G1<.2 

BSQs  2. C*GAMA*SIGYC ( Ip)  **2 

PuHc  ui  <*9 

YPRMU  =  YPARCIP)  ♦  S CRT ( ASQ*3INA**2  ♦  OSQ*COSA**2> 

PCmECIE £ 

YPRHL  =  2.  Q*YP  AR  (IF)  -  YPRMU 

FCHEC151 

c 

P  CHE  Cl i 2 

c 

DOES  THE  PARTICLE  CONTRIBUTE  TO  THE  MAP  WITHIN  ITS  VERTICAL 

pchlCI 53 

c 

(Y  AXIS)  LIMITS  - 

PCMECl 34 

c 

PCHEC: 55 

IF* YPRMU. GT.YNIN  ♦  CG Y. A NG . YPRML . LT . YM a X )  GO  10  205 

PCMECl 5fc 

200 

KTR (IP) =1 

PCHEC157 

NE=NE*1 

PCM-C15J 

GO  TO  777 

fCHtciiy 

20  5 

XPRMU  =  XPAR  (IPH-SQRT  CASQ*COS  A**2  ♦  3SQ*SINA**2) 

PC  M£0  Ifc j 

c 

t-CHto.-.i 

c 

DOES  THE  PARTICLE  CONTRIBUTION  LIE  COMPLETELY  BE  YONU  I  HE  LEFT 

PCM£Cii,2 

c 

POUNDPY  OF  THIS  MAP  CORE  LOAD  - 

FCm£u1 c i 

c 

PC  1  fc  -* 

IF  (  XPRM  U.LT  .Xi*-OGX  )  GO  TO  200 

Pv  i 5 

XPRML  =  2. 0  *XPAR ( IP )  -  XFRMU 

PC 

c 

PCM;,  el 

c 

DOES  THE  PARTICLE  CCMRIfiUTIOiJ  LIE  COMPLETELY  ItVOND  THE  RIGHT 

P  C  ME  L.  1  T/C 

c 

BOUNORY  OF  THIS  MAP  CORE  LOAD  - 

p  v/  Mt  C  1  o5 

c 

PCHtClTO 

TF (XPRML. LT.X2 )  GO  TC  22C 

^CMEClTl 

KTR (IP) =0 

p;heoiY2 

GO  TO  7 77 

PCMiClYi 

c 

PCMECl/4 

c 

WILL  THIS  CONTRIBUTE?  ALSO  CONTRIBUTE  TC  SL8SE  0UENT  PAP  CORE  LG A CS PCm£ C 1 75 

c 

PC  HEC 1 ^6 

220 

IF(XPRMU.GT.X2)  GO  TC  23C 

PCMEel 77 

KTR(IP) =1 

PCMECl 70 

NE=NE+1 

PC  ME  C 1 79 

GO  TO  240 

PCMf  Cl  5j 

165 


p,o  o  ooooooooooooooodoooooooooo 


230  KTR IIP) *0  PCHEC131 

240  CALL  CALCUP.OMAP.NMAP)  PCHEC132 

777  CONTINUE  PCHEC183 

C  PC  HE Cl 3 4 

RETURN  PCHEC135 

C  PCHEC136 

END  PCHEC137 


*  OECK* PDMP 

SUBROUTINE  POMP 

THIS  SUBROUTINE  SORTS  OUT  THOSE  PARCELS  THAT  WILL  CONTRIBUTE 
TO  SUBSEQUENT  NAP  CORE  LOADS.  ANC  OUHPS  THEH  ON  TO  TAPE  FOR 
TEMPORARY  STORAGE 


H.G.NORKENT 


JUNE  20,1971 


GLOSSARY  ************************** 


COUNT  OF  PARCELS  MOVED  FRCM  UPPER  TO  LOWER  CORE 
<JL.LE.KP> 

COUNT  CF  AVAILABLE  PARlEl  STORAGE  LOCATIONS  P.3SEO 
IN  THE  PARCEL  CORE  STORAGE  BLOCK  SORT 
<JP.LE.NE. AND. JP.LE.KP) 

NUMBER  CF  PARCELS  IN  COkE  THAT  APE  TO  t»E  DUMPED 
ONTO  TAPE 
<KP=NI J-NE) 

COUNT  OF  AVAILABLE  °ARCEL  STORAGE  LOCATIONS  IN 
CORE.  TRIS  IS  THE  NUMBER  CF  PARCELS  REJECTED 
IN  PCHECK. 

A  BLOCK  COUNT  OF  DATA  STORED  ON  TAFF  AND/OR  iN  CORE 


ALSO  SEE  OP  Ml  GLOSSARY 


COMMON  /CONCAT/ 


1ISIN  ,IS0UT  , 

2MARRAY  f  MBT  AP  E  , 

COMMON  /PAROAT/ 
igama  ,ktr<i:u  , 

2SlGV0(lr: » ,SINA  , 

JYPRMtJ  ,ZPAR<irt!> 

COMMON  /RUNOA  T /  C 

IMAPRUN  ,NE  i 

2CPMI  0(12)  »  T 1  , 

CAT  A  PR  UGRM/GH  POMP  / 


IC  (2  J ) 
,  JPOU  T 
, MXREQ 


, KPO  ut 


ASC  ,  0SQ 

,°M AS  <1)0)  ,PSIZ<100) 

,TPAR<1j0)  ,XPAR< 13*1 


,  IPNCF 
,  KT  APE 
,  IN  FA* 

,  CO  S  A 
,PO  (ICO) 
,YP AR  (ICO) 


,CF6 

»*<URO 


»ESUK 
,  NR  E  C 


,  IPOUT 
,LTAPE 

»F 

»  S IGXO (1 U0 ) 
, YPRML 


» I  CTR 
, NT  ASK 


.WFMAS  (2u0> 


KP=NI  J-NE 

IFINE.EQ.O)  GO  TO  1CCC 

JP=0 
M*MI J»1 
J«1 
JL=  0 

sou  through  the  stl  >eo  fauicle  data  bLCoK  «nd  hove  all 


POMP  1 
POMP  2 
POMP  3 
POMP  4 
POMP  5 
POMP  6 
POMP  7 
POMP  0 
POMP  9 
►POMP  10 
POMP  11 
POMP  12 
PDMP  13 
POMP  14 
POMP  15 
POMP  16 
POMP  IT 
POMP  18 
POMP  19 
POMP  2 0 
POMP  21 
POMP  22 
POMP  23 
POMP  24 
POMP  25 
POMP  26 
►POMP  27 
POMP  28 
, POMP  29 
, PD  MP  30 
POMP  31 
, PDMP  32 
,POMP  33 
, POMP  34 
POMP  35 
, POMP  36 
.POMP  37 
POMP  38 
POMP  39 
POMP  40 
ROMP  41 
POMP  42 
POMP  43 
POMP  44 
POMP  45 
POMP  46 
POMP  47 
POMP  48 
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C  PARTICLE  DATA  TO  BE  CUHPEO  INTO  LOWER  CORE  SC  THAT  IT  IS 

C  CONTAINED  IN  A  SOLIC  OATA  3L0CK  (I.E.  A  DATA  BLOCK  WITH  NO 

C  REJECTED  PARTICLES  IN  IT) 

C 

no  300  1=1, KP 

If (KTR<I».£Qc0i  GO  TO  300 

JP= JPH1 

DO  2C  C  K=J  »NE 

L=H-K 

IF(KTR(L).EQ.l)GO  TC  10C 
JL=  JL  +  1'. 

KK  =  K 
C 

C  MOVE  PARCEL  DATA  TC  AVAILABLE  STORAGE  IN  LOWER  CORE 
C 

XPAR( I ) -XPARCL) 

YPAR(I) *YPAR(L) 

ZPAR(I)=ZPAR(L) 

TPAR(I) =TPAR(L) 

SIGXO(I)=SIGXO<L) 

SIGYOd  l=SIGYO(L) 

RO ( I ) =RO ( L ) 

PSIZ(I)  =PSIZ<D 
PMASCI) =PM AS ( L ) 

GO  TO  260 
100  JP=JP+l 
2)0  CONTINUE 
250  IRROR=-250 
GO  TO  20)0 
26  (  J=KK  +  i 
S0Q  CONTINUE 

IFtJP.LE.NE)  GO  TO  500 
310  IRROR=-310 


POMP  49 
POMP  50 
POMP  51 
POMP  52 
POMP  53 
POMP  54 
POMP  55 
FOHP  56 
POMP  57 
POMP  58 
POMP  59 
POMP  60 
POMP  G1 
POMP  62 
POMP  63 
POMP  64 
POMP  65 
POMP  66 
POMP  67 
POMP  68 
POMP  69 
POMP  70 
POMP  71 
POMP  72 
POMP  73 
POMP  74 
POMP  75 
POMP  76 
POMP  77 
POMP  78 
POMP  79 
POMP  60 
PQMP  81 


GO  TO  2  00 

POMP 

82 

500 

IF < JL.LE.KPJGO  TO  1QQC 

POMP 

83 

510 

IRROR=-5lO 

POMP 

64 

2C  0  0 

CALL  ERRORCPROGRM, IRRCR, ISOUT) 

POMP 

85 

1CO0 

WRITE(LTAPE)KP 

POMP 

86 

WRITE(LTAPE) (XPAR(I) ,YPARCI) ,ZPAR(I) ,TPAR(I) ,SIGXOCI),SIGYO(I)  , 

POMP 

67 

1  RO ( I ) , PSI Z(I)»PMAS(J)»I=i,KP) 

POMP 

66 

RETURN 

POMP 

69 

END 

POMP 

90 
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oooooorjoooooooooooo 


♦DECK, SRTCNT 

SUBROUTINE  SRTCNT (  X,  Y,  CNT .  K,  CRDLBL) 


X.Y  - 
CNT  - 
< 

XX, YY- 
X°»  Y  P- 


POINT  COORDINATES 
CONTOUR  VALUE 
NUMBER  CF  POINTS 
FIRST  PCINT  ON  A  CONTOUR 


COMMON  /CONOAT/  IC  C  20 »  ,XHQB 

1ISIN  .ISOUT  » JPOUT  ,<PUUT 

2MARRAY  ,  MBT  APE  .MXREQ  ,SO 

OIMENSI ON  X  C  3  0  0 )  ,  Y  <  30  0  I 
DATA  CL R t  PROGRM/  1.E3D,  6H SRTCNT/ 

OAT  A  COOE/  6HDELFIC / 

VEC (A  «9  «C, 0)  =  ( A-C ) **  2  ♦  ( 0-0) ^*2 
ILOOP=0 

40  IF  <  K  .  GT.  3)  GO  TO  55 
WRITEdSOUT,  3000) 

HO  5C  1=1. K 

WRI TE (  ISOUT,  10C0)  CNT.Xd),  Y(I) 


WRITEdSOUT,  1C00) 
RETURN 


CNT.X(l)  »  Yd) 


55  ILOO°=ILOQP»l 

IFTILOOP  .GT.  n  GO  TO  100 
VEM*VEC (X ( 1 ) »  Y d ) »  X 12 ) »  V  i2>> 

m=2 

ro  f '  I  =  I.  K 

IF(VEC(X(1),»  d)«X(l).V  CD)  .GT.  VEM 
M  =  I 

V*M  =  Vfc: IXCl ).Y< 1) ,x ( II , Y  (I) ) 

61  COdlNU- 
DO  65  1=2, K 
I F f I  .EO.  Ml  GO  TO  65 

IF  (VECIXIMI  ,YIM|  ,XU),V(II  I  .U,  VEf 
65  CONTINUE 
*P  =  Xd) 

YP= V<1) 

DO  7W  1=2. < 

xii-i?  =  xm 

73  Yd-l>  =  YdJ 
X l< l=XP 
y <<)  s  yp 
GO  TO 

COMMENCE  CALCULATION  OF  A  CONTOUR  CLUSURE 


SRTCN 

1 

SRTCN 

2 

SRTCN 

3 

ES  -  MARCH  1979 

SRTCR 

4 

SRTCN 

5 

SRTCN 

6 

SRTCN 

7 

HE  POINTS  ARE 

SRTCN 

e 

,  THE  CLOSEST  POINT  TO 

SRTCN 

9 

GREGATEO. 

SRTCN 

10 

SRTCN 

11 

*++*#*+**«**#**»srtcN 

12 

SRTCN 

13 

SRTCN 

14 

SRTCN 

15 

SRTCN 

16 

SRTCN 

17 

t  CONTCUR 

SRTCN 

16 

SRTCN 

19 

i  »*•*  ¥»*  *»**»♦♦**,  S^TCN 

20 

SdCN 

21 

, IP  NC  H  ,IPOUT 

, SRTCN 

22 

,  KT  AF  F  ,  L T  AP  E 

.SRTCN 

23 

,  IN  F  AM 

SRTCN 

24 

SRTCN 

25 

SRTCN 

26 

SRTCN 

27 

SRTCN 

28 

SRTCN 

29 

SRTCN 

30 

SRTCN 

31 

SRTCN 

32 

SRTCN 

33 

,Y(  I)  .GRULBL,  COOE 

SRTCN 

34 

1  ,Y(  1) .CRDLBl..  COOE 

SRTCN 

35 

SRTCN 

36 

SRTCN 

37 

A  TWC-POINT  CLOSURE 

SRTCN 

36 

SRTCN 

39 

SRTCN 

40 

SRTCN 

4  1 

SRTCN 

42 

SRTCN 

43 

:  to 

SRTCN 

44 

SRTCN 

45 

SRTCN 

h6 

SRTCN 

h7 

SRTCN 

48 

SRTCN 

49 

3  1C  J 

SRTCN 

50 

SRTCN 

51 

SRTCN 

52 

SRTCN 

53 

SRTCN 

5  4 

SRTCN 

55 

SRTCN 

56 

sRTCN 

57 

jRTCN 

58 

SRTCN 

59 

SRTCN 

oO 
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‘JiU, L/m^ 


100 

XP  =  X(l) 

SRTCN 

61 

yp  =  riii 

SRTCN 

62 

XX  =  X  C 1 ) 

SRTCN 

63 

YY  =  Y  < 1 ) 

SRTCN 

64 

KK  =  1 

SRTCN 

65 

VEM  =  VEC!XP,  YP,  X<2>,  Y(2>) 

SRTCN 

66 

M  =  2 

SRTCN 

67 

WRITEdSOUT,  3000) 

SRTCN 

69 

WRI TE (  ISOUT,  1000)  CNT,  XP,  YP 

SRTCN 

69 

IFCIPNCH  . GT«  0)  WRITE(IFNCH,2000)CNT, 

XF, 

YP,  CRDLBL, 

COOE 

SRTCN 

n 

L  =  3 

SRTCN 

71 

600 

DO  700  I-L » K 

SRTCN 

72 

IFIX(I)  ,EQ.  CLR)  GO  TO  700 

SRTCN 

73 

IF (  VEC!  XP,  YP,  X(I),  rill)  .ST.  VEM ) 

GO 

TO  7 0 u 

SRTCN 

74 

M  *  I 

SRTCN 

75 

VEM  =  VECl  XP,  YP,  XII),  Y  ( I) ) 

SRTCN 

76 

700 

CONTINUE 

SRTCN 

77 

701 

XP  =  X  (  M) 

SRTCN 

79 

YP  =  Y1M) 

SRTCN 

79 

X  ( M  )  =  CLR 

SRTCN 

30 

WRITE!  ISOUT,  1C00  )  CNT,  XP,  YP 

SRTCN 

31 

X  F  C IPNCH  .  GT.  0)  WRITE!  IPNCH,20  JJ)CNT, 

XP, 

YP,  CRDLBL, 

CODE 

SRTCN 

32 

702 

IF!  VEC!  XP,  YP,  XX,  YY  )  ,EQ.  3.0)  GO 

TC 

75L 

SRTCN 

63 

L=  1 

SRTCN 

94 

KK  =  KK  ♦  1 

oRTCN 

j5 

70  5 

OO  710  1=1, K 

SRTCN 

j6 

IF!  XII)  .EQ.  CLR)  GC  TO  710 

SRTCN 

67 

VEM=  VEC!  XP,  YP,  XU),  Y 1 1 ) ) 

SRTCN 

98 

M  =  I 

SRTCN 

69 

GO  TO  600 

SRTCN 

9  J 

710 

CONTINUE 

SRTCN 

91 

CALL  ERROR!  PROGRM ,  -710,  ISOUT) 

SRTCN 

92 

750 

IF!  KK  .EQ.  K)  RETURN 

SRTCN 

93 

iOMMENCE  INITIALIZATION  FOR  ANOTHER  CLOSURE. 

SRTCN 

?4 

CONOENSE  REMAINING  POINTS  INTO  LOWER  CORE.  SRTCN  95 


KP=K-KK 

SRTCN  96 

KKP  =  KP«-1 

SRTCN  97 

OO  7 V0  1=1, KP 

SRTCN  96 

IFlXCf)  .NE.  CLR)  GC  TO  770 

SRTCN  99 

DO  76C  J=KKP, K 

SRTCNl  -i 

IF ( X  <  J )  .EQ.  CLR)  GC  TO  76, 

SRTCNl'i  1 

X (I )=X ! J) 

SRTCNl, 2 

Yil )=Y! J) 

SRTCNl, 3 

Xt.J)=CLR 

SRTCNl, 4 

GO  TO  768 

SRTC  N1 5 

760 

CONTINUE 

SRTCNl I  6 

765 

CALL  ERROR (PROGRM, -765, ISOUT) 

SRTCNl J  7 

76  8 

KKP=J+1 

SRTCNl j  9 

77C 

CONTINUE 

SRTCN109 

iloop=o 

sRTCNll G 

K=KP 

SR  TC  N 11 1 

GO  TO  40 

sRTCN 112 

1000 

FORMAT!  5X ,  3F1C.0) 

SRTCNll 3 

2100 

FORMAT!  3F10.0,  10X,  A10,  10X,  A6) 

SR  TC  N1 14 

3CC  0 

FORMAT! 1H0) 

SRTCNU5 

ENj 

SRTCNl 16 
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*0ECK,PAM1 

PAM1 

1 

SUBROUTINE  PA Ml 

PA  Ml 

2 

1  (HOB 

tSLOTHP  ,TMSD  ,TW  , EMITN,  FiSSID  ) 

PAM1 

3 

C 

PA  Ml 

4 

C 

P.  C  TOMPKINS  —  US  ARMY  NUCLZAk  DEFENSE  LABS 

PAM1 

5 

C 

TAPELESS 

VERSION  FEBRUARY  1971 

PAH1 

6 

c 

OCTOBER 

1966 

mAMI 

7 

c 

PAM1 

6 

c 

EXECUTIVE 

PROGRAM  FOR  TIME -I NOE PEN CENT  PART  OF  ? AfiTI CLt- ACT  I V IT Y 

PAM1 

9 

c 

MODULE 

FA  Ml 

10 

c 

RAMI 

11 

CALLED  BY  OPM 1 

pami 

12 

C 

PA  Ml 

13 

c 

PAMI 

i  4 

c 

PAMI 

15 

c 

CAPFIS 

CAPTLRE-TO-FISSION  RATIO 

PAMI 

16 

c 

EMITN 

NUMBtR  CF  NEUTRONS  EMITTED  PER  FISSICN 

PAMI 

17 

c 

FISSIO 

SIX  CHARACTER  IDENTIFIER  OF  FISSION  TYPE 

PAMI 

16 

c 

IFTAPE(IO) 

LOGICAL  ARRAY  TO  CONTROL  FILE  MANi.  (ULATION 

P*M1 

19 

c 

(1)  TP.UE  -  SET  INTP  NOT  EQUAL  TO  ISIN 

PAMI 

2  U 

c 

FALSE  -  SET  INTP  =  ISIN 

PAMI 

21 

c 

(2)  TRUE  -  SET  KRQ  =  INTP 

PAMI 

cZ 

c 

FALSE  -  SET  KRO  =  ISIN 

PAMI 

23 

c 

(3)  TRUE  -  WRITE  FILE  IPAM 

PAMI 

24 

c 

(LI  TRUE  -  READ  FILE  IPAM  INTO  MEMORY  ANO  RETURN 

PAMI 

25 

c 

(5-ltl  SFARES 

FAMi 

cb 

c 

IPAM 

BINARY  FILE  OF  PAM1  OUTPUT  FCk  RESTARTS 

PAMI 

c7 

c 

IS  IN 

INPUT  FILE  (BCD)  USEO  BY  OTHER  DELFIC  MODULES 

PAMI 

26 

c 

KOUT 

BCD  FILE  OF  FAN  OUTPUT  FOR  PERIPHERAL  PF  INTI  ItG 

PAMI 

29 

c 

KRO 

INPUT  FILE  (BCOI  CONTAINING  SOIL  PARAMETFRS 

pami 

SO 

c 

NPRNT  (  20) 

LOGICAL  ARRAY  TO  CONTROL  WRITING  OF  KOUT,  TRUE  =  MRITEPAM1 

31 

c 

(1)  SETUP  -  TRANSITION  CAPOS  (MINING  -  PRODUCES  SOM 

i  F  AM  1 

32 

c 

700  CAGES! 

PAMI 

33 

c 

(2)  SETUP  -  INTERMEDIATE  FORM  OF  NUCLIDE  TABLE  (OCTALPAM1 

34 

c 

(3)  SETUP  -  FINAL  FCRH  OF  NUCLILl  TABLE  (OCTAL) 

PAMI 

35 

c 

(4)  YIELD  -  FISSION  YIELD  TABLE 

PAMI 

36 

c 

(5)  XPRM  -  EXPOSURE  RATE  MULTIPLIERS 

PAMI 

37 

c 

(6)  FRATIO  -  REFRACTORY  FRACTIONS  (FR) 

PAMI 

56 

c 

(7)  FRATIO  -  SOUAPE  ROOT  OF  FR  (dSUBO 

PAMI 

39 

c 

(t)  INOCOl  -  INFQkMATION  STORED  FCP  USE  BY  ISOLDE 

PAMI 

43 

c 

('.«)  BATMAN  -  HUCLiO:'  A9UNc*NlES  (HA*-Nlf!G  -  THIS 

PAMI 

**1 

c 

OPTION  COMBINED  WITH  UO  =  FALSE  MILL  BURY  YOU 

PAMI 

42 

c 

IN  FAFER) 

PA  Ml 

42 

c 

(tel  GXFSR  -  FISSION  pRoUUlT  ACTIVITY  VS  PART  SIZE 

PAMI 

44 

c 

(WARNING  -  SEE  OH 

PA  HI 

45 

c 

(111  INCCD2  -  INUUCEO  ACTIVITY  (COIL)  VS  PART  SIZE 

PAhl 

46 

c 

(WARNING  -  SEE  (9)1 

PAMI 

47 

c 

(121  UR AN  -  INUUCEO  ACTIVITY  (MASS  239)  VS  PA*T  SIZE 

PAlIl 

4o 

c 

(WARNING  -  SEt  (9)1 

P*4M1 

49 

c 

(131  MCHCEP  -  SELECTED  MASS  CHAIN  AC1IV1Y  VS  PART  SIZ 

epahi 

50 

c 

(141  SPARE 

PAMI 

51 

c 

(151  PAH2  -  00  NUT  WRITE  TOTAL  ALT  1 V  IT  V  VS  PARTICLE 

PAMI 

52 

c 

SIZE  (WARNING-StE  (9)) 

PAMI 

53 

c 

(lE-cC)  SPARES 

PAMI 

54 

c 

PAHI3 (12) 

RUN  IOENTIFICAT ION  PC  R  P ART  I  CL  £  -  AC T  I V I T Y  HJOULE 

PAMI 

55 

c 

«  «  *  « 

•  ••••«•••  #  •  • 

PAMI 

•jb 

c 

PAMI 

57 

common  / 

'OONDA  T /  I  C  (  2  '  )  ,  I HO  B  ,IPNLH  ,1PAH 

,  PAH1 

56 

1  KRQ 

, I SOUT  , JPOUT  ,<?OUT  , KT  APE  , LT  APE 

,pahi 

59 

2MARRAY 

, MAT  APE  ,H  XREQ  .SIGMA  , IN  T  F 

PAMi 

60 

170 

COMMON  /OECAY/  IGO, JC.KDOS, TENTER, TEXI T, TIME  PAMl  61 

COMMON  /FISHIN/  ABE GK ( 70 0 » , ABUNQC (7 0 0 ) , BRANCH! 130»  ,CAPFIS ,  PAM1  62 

1  OCONC700J oISRA, IMJC,HAXNUC«MULT(il), NUCLID  <7  00  )  PAM1  63 

COMMON  /FRY LNG/  BSUe K<90 > , ERM < 18 5) , JRM ( 16 5) , KR M * ECF ( 90 >  PAM1  64 

COMMON/INDUS/ALBFOK,FAC<7,ia>,FOG*NY<7,18>,ISCUe>  ,LM*  X,  XLAM  (7,1  8)  PAMl  65 

COMMON  /OUTPUT/  FISMM,  FF (  2  00 )  ,  FW,  IT  AB  ,  JGO  , M  AS  CHN,  PS  I7E  (  20  0  >  ,  PAM1  66 

1  FMASS(203) ,PACT(23J)  PAM1  67 

COMMON  /UTILTY/  KCUT.NPRNT ( 15)  PAMl  68 

LOGICAL  IGO, JO, KOOS , KPRNT  PAMl  69 

INTEGER  TYPEI12)  »  FISSIO  PAMl  70 


OATA  TYPE/6HP239FI,6HP239HE, 6HP2 39TH , 6H U233FI , 6HU233HE, 6HU233TH,  PAMl  71 
1  6HU235FI, 6HU2  3  5HE,6HU2  35TH,6HU238FI,6HU236HE,6HU238TN/  PAMl  72 

PAMl  73 


DATA  (BRANCHCI), 1=1,95  )/  PAMl  74 


$ 

S. OQOOOOE-1, 

4.  000  QCDE-1, 

3.600  OOOE-1, 

6.4000  OuE-i, 

5.0  OJOOOE-l, 

PAMl 

75 

s 

5. OOCOOOE-l, 

6*  000  0  0  0E-2 • 

9.40J030E-1, 

4*4040  OOE-1, 

5.60u400E-l, 

PAMl 

76 

s 

1. 0303  JOE-1, 

9*  0  0  0  0  OCE  -  1, 

1.9U0GQ0E-1, 

8 .10  00  OCE- 1, 

3.0  uOO JOE-2, 

PAMl 

77 

s 

9.  7303  OOE-1, 

7.  000  COOE-2, 

9 . 30 0 0 0 Ot-l , 

1. 1840  OOE-1, 

8.82000  OE-1 , 

PAMl 

76 

$ 

1, 500300E-1, 

8.  500  0  C0E-1, 

6.30  0  0 JJE-1  , 

4*00ou00E-l, 

2.5  00  0  JOE-1  , 

PAMl 

79 

3 

7.  530130E-1, 

2.  000  UCQE-2, 

9.30  0  0  00E-1  , 

9. 604000  E-l, 

4.  0  00  OOOE-2 , 

PAMl 

60 

$ 

8.  7000  JOE-1, 

1*  300  0  COE- 1 , 

5.000  0 JJE-1  , 

5.0  0  04  OOE-1, 

9.95000  OE-1  , 

PAMl 

61 

$ 

5. U00C0E-3, 

2.  Q60C0UE-1, 

7.940  OOOE-1, 

5.COCOOCE-1, 

5.0  00 OOOE-1, 

PAMl 

62 

I 

5.  0000  ODE-1, 

5*  000  0  JOE- i , 

5 . 00  0  C0  0E-1  , 

5.00:0  JOE-1, 

1.0C400  0E-2, 

PAMl 

83 

$ 

9.  9 3 Of)  OOE-1, 

6.  80  31i  COE- 1, 

3.200Q00E-1, 

5.  04  40  04E-1, 

5.0  0000  OE-1 , 

PAMl 

84 

s 

9. OOOCOOE-l, 

1*  0  00  Q COE- 3, 

5. 300000E-1, 

E.OOCu  30E-1, 

7.24J000E-1 , 

PAMl 

85 

$ 

1*4  ^  '  E  —  1 , 

i.  432  »:j;e-i. 

9. J" i j  3 Jt-2 , 

9.  1  u  :  4  3  t.  -  - 1 , 

9 • 5  u  u  J  3  lt-1 , 

PAMl 

c6 

s 

5. OTOOCOE-2, 

5*  C  0  0  0  CuE-  1, 

5.00  3  0  3JE-1 , 

6.  CO 4Q  OOE-1, 

l.OCOO JOE-1, 

PAMl 

87 

$ 

3. 310003E-1, 

2.190  000E-1, 

7.30  0  01)  JE-1, 

1. 0014  QCE-3, 

5.000  0  COE-1 , 

PAMl 

68 

3 

5.  0000  OQE-i  , 

5*  0  GO  C  COE-  <, 

5.00  000JE-1 , 

4*  50:J  OOE-1, 

5.0C00Q0E-1, 

PAMl 

89 

$ 

5.  0300  03E-1, 

3*  0000  COE-  I, 

9.70  0  OOOE-1 , 

5.0004 OC E-l, 

5.0  000  0  OE-1 . 

PAMl 

90 

$ 

5.  0P0Q0JE-1, 

5.  000  0  COE-1, 

2.150  OOOE-1 , 

7. 8500)02-1, 

9.9  30  3  OuE-1 , 

PAMl 

91 

$ 

1.  1003  01E-2, 

5.  003  CC3E-1, 

5.30  0  COOE-1, 

2 . 2  0 GO OOE-1, 

7.80000CE-1, 

PAMl 

92 

s 

9,  8000  00E-1, 

2*  0  0  0  0  COE- 2, 

9 .70  0  00 JE-1 , 

3. 00  CO OCE- 2, 

6.5  mO OOOE-2/ 

PAMl 

93 

DATA  (BRANCH(I) ,1=96,130  )/ 

PAMl 

94 

3 

9.  3500  33E-1, 

1.  730  00JE-  J, 

8. 27000 JE-1, 

6.8  040  UCE-1, 

3,2  000  OOE-i  , 

PAMl 

95 

J 

9.  0300  JOE-1, 

1.  000  OOOE-1, 

1.5CJOOJE-1, 

8  •  50  44  OOE-1, 

2.0  OuJ  OOE-1 , 

PAMl 

96 

$ 

8, 01009JE-1, 

8. JO 0  0  COE-  It 

9. 920 OOOE-1  , 

7*204000 E-l, 

2.8  003  0LE-1, 

PAMl 

97 

$ 

1. 300000E-1, 

8.  700  OOOE-1, 

2.400  OOOE-2, 

9  .7600  04E-1, 

3.0  40  0  OOE-1 , 

PAMl 

98 

$ 

7. 30 0000 E-l, 

4.  000  0C0E-2, 

9.6OOC0OE-1, 

9.2000  OOE-1, 

8.0  000  0  CE-2, 

PAMl 

99 

3 

3. OQOOOOE-2, 

9. 7C0  OOOE-1, 

4. 3U  0  000E-2  , 

9.60  00  OOE-1, 

7.5  00004E-1 , 

PAMl 

100 

$ 

2. 50003QE-1, 

7*  300  0  COE-  1, 

2.700000E-1, 

0.004000  , 

4.000000  / 

PAMl 

101 

DATA  (O  CUN  (I), 1=1, 95  1/ 

PAMl 

102 

3 

6.931470E41, 

1*  98  0  4  20E- 1, 

6. 931473E-2 , 

4.140663E-6, 

1. 365538E-5 , 

PAMl 

1C  3 

$ 

0.000333  , 

6. 93147UE+1, 

3.465735E-1, 

9.90 21 OCE- 2, 

5. 776225E-3 , 

PAMl 

104 

$ 

4. 011267E-5, 

1*30  76  25E ♦ 0 , 

0.000000  , 

6  .93147uEfl, 

4.62J98CE-1, 

PAMl 

14  5 

3 

1.  732867E-1, 

2*5672  HE -  3, 

1.481083E-3, 

J.OOCOOC  , 

6.93147CE+1 , 

PAMl 

106 

3 

6.931470E+1, 

2.  772  588E-1, 

7. 296284E-2 , 

5.7762  25E-3, 

1.414566E-2 , 

PAMl 

107 

3 

1.  438335E-4, 

0.000000  , 

6.93147JE+1, 

3. 4657  3  5E-1, 

6,6643  3  7E-2 , 

PAMl 

108 

3 

2. 31049JE-2, 

C. 003  COO  * 

7.265692E-6 , 

0.0  004  3  4  , 

b.  931  4  7CE  *-1  , 

PAMl 

13  9 

3 

4.  620983E-1, 

1* 98042JE- 1, 

4.62098  QE-2 , 

1.283606E-2, 

1,7  0390  IE-5 , 

PAMl 

110 

3 

4.975215E-6, 

0.0 CD  COO  , 

6 . 93 147  JE  +1  , 

6.931470E«-1, 

2.772588E-1 , 

PAMl 

111 

3 

8. 664337E-2, 

9.  16861  IE -  5, 

1.9Z54J8t-3 , 

1.2695CQE-4, 

O.OOOOuC  , 

PAMl 

112 

S 

6. 93147JE+1, 

4.  €2098  0E-  1, 

1.540  327E-1 , 

2.772588E-2. 

1.28360 6E -3 , 

PAMl 

113 

$ 

2,  969781E-3, 

3.66J  750E-13, 

vi.wJJOjC 

,  6.9314  7 4E  +  1, 

4.  62 0960 E-l, PAMl 

114 

3 

2. 31349JE-1* 

2.  772  586E-  t, 

1.925408E-2 , 

J.lOuU )D  , 

6.931  47JEH  , 

PAMl 

115 

3 

6.  9  3147  1E+1* 

3.465  725E-  1, 

9.9:213 JE-2, 

2.10 J445E-2, 

2.0  26746E-4 , 

PAMl 

116 

3 

6.41S023E-4, 

3.  30  J  CO'1  , 

6.931470E+1 , 

4.62098LE-1, 

1.3362  94E-1 , 

PAMl 

117 

s 

3. 8548 17E-2, 

?  •  0  0  J  jOC  , 

5. 36  3 2 54 E -6  , 

3.00uG3C  , 

6.93i**7le+i, 

PAMl 

lie 

3 

6.931473E41, 

3.  465  735E-  1, 

9.9321 JJE-2  , 

1.0  0  45  6 IE- 2, 

4. 62  J  98CE- 4 , 

PAMl 

119 

3 

8.  0225  35E-5, 

1*31337  3E- 4, 

0 . 3: 0  C  Qu  , 

6.93147CE+1, 

4.  62  096PE-1 , 

PAMl 

120 

W  t*M»  1»  'A  M  ^  >1  V)  W  M  <A  M  •/)  '><  W  M  ■«  .“t  fart  fa*  fa4  «*  /(  W  l),  «  l«.«  I'l  i*ji  W  »  M  «  W« 


OAT  A  ( P  CON  I 
S  6.  9314  7  IE -i, 
3  2.J72123E-9. 
S  1.  155245E-2, 
S  6.  93147JE+-1, 
$  i.  <K05ilE-i‘ 
S  4, 252436E-2. 
$  3.  46573SE-1, 
S  4.  3321  69E-2, 
£  2.  i:T445E-2, 


2.  ili 4 Q  6-4, 
2.  31f  49.1E-1, 


DAT  A  (OCON 


1. J  451 29E-13  « 


.T.3r;r0u)  , 

1.  0  J4561E-3, 
4.  62C98JE-1, 
2. 026746E-4, 
4.  62 09 8  0E- 3, 
0.0  ICO  GO  . 


5  •  2  5ii..4_  —  •+, 

3, 465735E-1, 
DATA  ( D  CON  {] 
6.93l47JEil, 
1. 386294E-2, 

0 .  1  0  Cl  1  .  , 

1. 386294E-1, 
1.  732867E-1, 
1.  0  55597E-6, 
9.  9  u  21 9  i£-  2, 
6.93147JE  +  1, 
3.  6  32846E-5, 
2.310490E-1, 
6.  9314  71E-1, 
1.8657  D6E-7, 
6.9314  7  it  +  lr 
■J .  J  ‘  Z  J  .3  . 

1.  35D223E-2, 
5.  73C382E-7, 

2.  772588E-2, 
6.93l47JE«-l. 


3. 8508175-3, 

3. 610141E-4, 

.  C  G  .  0  0  L  , 

6.93l47C£«-l/ 

5AM 1 

121 

)* 1=96,19 J  )/ 

J-AH1 

122 

1. 61197CE4u» 

1.  777  3  J.iE-2, 

3.85 lO 17E-3, 

4.  37592<’E-5  , 

6*AMl 

123 

C.  OCddCO  , 

6.93147JE+1, 

3.4667  35E-1, 

4.332169E-2, 

RAMI 

124 

0.  J  JO  GLG  , 

1.U0812E-2, 

4. 3131916-7, 

C.O.O.du  , 

6  A  Ml 

lc5 

4.  623  9  f  PE-  It 

4.332163E-2  , 

1.2718 29E-2, 

1.401J 83E-4 , 

rami 

126 

O.OOJOOU  , 

6.93147CE+1, 

6. 9314705+1 

2.  7725odt-l,f'AMi 

127 

6. 876458E-5, 

6. 413028E-4, 

.  «  0  Q  .{.  n  t  , 

6.931 47  1E*1 , 

PAMl 

128 

1.5753  24E-1, 

3.610 141 E-3  , 

7  •  50 15  9 1  £*h; 

1. 5o862  IE-7 , 

rami 

129 

j  •  u  0  0  0  0  9  t 

6.931470E+1, 

6.9314706+1, 

4.332169E-1 , 

PAMl 

13  j 

4.2  7  86  85E  -  2* 

7  .8444556- 1  u  , 

2. 994414E-6 

w.oOOOOO  , 

RAMI 

131 

3. 465735E-1, 

6.931470E-2  , 

9  »  b2  70 42E-3, 

1.984957E-5 , 

PAMl 

132 

1.  0*  i.  <ot-7. 

J  •  /  d  1  tf  9 

6  .  -i  3  .  *♦  7  .  *  l , 

4 . 62  0  *  ;  .  , 

PAiil 

di« 

1. 397825E-  1, 

7  •  1 3il<+2E-5 , 

5  » 3 4t  3  5fc  E-5  , 

J  .  'J  *  J  y  j  w  , 

PAMl 

1 1  4 

6.  931470E*  It 

3.4b5735t.-i» 

1.237762E-1, 

1  •  4  4h  0  5  6E-3  , 

PAMl 

135 

2.  312  9  53E-14, 

5.9363 52 E-9  , 

0  .  u  >6  0 

,  6.  9314  ?Jt*  1, 

P  Alii 

life 

2.  31045 9 E-  It 

8. 8d65 J OE-3, 

5.7762256-4, 

G.C.jOgw  , 

RAMI 

137 

6.  9314  7  JE*  It 

3.  '*65  ?  J5E-1 , 

1.7  32?  67E-2, 

1.1552  456  —  3 , 

PA  Ml 

lie 

2. 1393A3E-6, 

2.292153E-7, 

.  uOU  l«b  • 

6,92 1-4?  tE  +  1 , 

RAMI 

159 

6.9314  70E-  3, 

2.772530E-1, 

5  «  d  2  2c  J  46*  3  , 

O.O.uOjc  , 

PAMl 

1  40 

G  ,  j  (  J  l)  fl  0  t 

6.93147  D  E  ii  » 

6. 9314  7  j£+l. 

4. 6  2  ^  t8 CL-1  / 

r  4  M 1 

141 

), 1=151,2851/ 

PAMl 

142 

1. 132593E-5, 

1. 1552456-2, 

1. 58t527fc-4, 

J.  C  *  J  *  ,w  , 

PAMl 

143 

6.97147-E+l, 

6.9314706*1, 

2.7725 8c 5-1, 

1.1552455-2  , 

P  4/11 

144 

5.  776225E-3, 

g.3u093J  , 

6.93147lE+1, 

6. 93147 .E-l, 

PAMl 

145 

4,  332169E-  1, 

5.  )228J4t-3, 

2.8953  51t-6, 

3.2  *90146-5, 

F  AMI 

146 

6.000000  . 

6. 9314706+1, 

4. 62G9F  .E-l 

,  1  •  So  *  42k  £— 1 , 

PAMl 

147 

U.JOGjCj  t 

4, 332169E-2, 

G.CUuCOc  , 

b. 93147 2c.il  , 

PAMl 

1  40 

2.  772  E  66E-  3, 

1.1 552t5E-2 , 

7.912637E-4, 

8 . 2  51 7  52E-4  , 

p  API 

149 

6.  93147JER  3 1 

6. 93147  OEtl, 

3.4657  35E-1, 

9.9  i*21uijE-2  , 

PAMl 

15G 

2,  5672  31E-2, 

1. It 6234E-1 , 

...d.dJC  , 

b.93147wE*l  , 

PAM. 

*51 

1.7328676-1, 

2.7725386*2, 

9.6271 426-3, 

2.C  20  7  9GE-7 , 

PAMl 

152 

a.ojocco  , 

6.9ol47gE  +1  , 

6 .93 14  70  E+ 1 » 

2.3.J492E-1  , 

PAMl 

153 

6.418'!<8E-t, 

d.OOuJJu  , 

2.6255576-3, 

1.65.  35  C6-2, 

RAMI 

1  34 

6.  931 4  795 ♦  3, 

6.93147 JE*1, 

2,4657  25 E-l , 

5.  77b2Z5E-3  . 

PAMl 

135 

4.  37592  8E -  5, 

1.824071E-2, 

5.3483  56E-6, 

0  .  0  .  3  *  u  .  , 

PAMl 

156 

6.  931470E-*-  It 

4.620ysJE-l, 

1.7326  67E-1 , 

7.7  J 1 o3  3E-2  , 

PAMl 

15  7 

8.751356E- 5, 

2.3i)493t-2, 

.  .  J  1)  ul  J  l  , 

6.93  14  7  26*1  , 

pAMI 

1 

2. 77258*5- 3, 

1. 155243L-2, 

2 . 5 1 1*. )  c  —  o , 

1.54,3t7c.-2  , 

PAM 

1 

i»l“776b£-)5» 

... 

6  •  * 1  i*7'  T ♦  1 

,  6.:  3  14  7.fi., 

1  AN  1 

It  1 

1.  135H45E-2, 

2.686616E-3, 

3.*  5  J6  17E-2, 

O.udJOOc  / 

P  AMI 

161 

) ,1=236.384) / 

RAMI 

162 

6.9314? DE*!, 

4. 62u9d OE-i , 

2.7725 06 6- 1, 

4.  332169E-2  , 

PAMl 

163 

2.  310  499E-2, 

2.  457  j6bE-3  , 

1. 3 7 52 92 E- 5, 

1.77  73  JOE-2  , 

PAM. 

164 

6.  931 4  7 )£♦  3, 

6.93147JE-1, 

3,4657 35 E-l, 

6.9314706-2  , 

PAMl 

1 15 

u.GOCOuC  , 

6. 9314706+1  , 

6.9314  7 L  F  + 1 , 

4.  62 J90CE-1  , 

r-AMl 

166 

5,  776225E-2, 

3.5ud  7426-5  , 

5.  C-228  J  4  c-4. 

9.  3  bo  ?  51E-3 , 

PAMl 

167 

3  .  <.  0  0  3  00  t 

6.93l47dE+l  , 

4. 62v9  8LE-1, 

2.  71. 490E-1  , 

PAMl 

16e 

9.  1686  31E-6, 

6.  '0169016*5, 

j.COuGL*  , 

6.93147 t£il , 

RAMI 

1  o9 

3. 465735E- 1, 

1. 752867E-1 , 

?.  2517  5C E-3, 

9.627J42E-3  , 

PAMl 

17  0 

j.orooor  , 

6. 9 314706  +  1, 

6 .93 14  7 1.  E+ 1 » 

4 *  6  2  j  -it  2£-l  « 

PAMl 

171 

4.  p  13  521E  -  2, 

1.3o6294E-1, 

. • u  J.l  Jl  , 

b. 93147 'j£il  , 

PAMl 

172 

2. 772568E-1, 

1.5*4  J  J27E-2, 

3.  4657  35F-2, 

5.5  .116 75-4, 

PAMl 

173 

3. 63  2c  4 bE- 6, 

4.26.iljot~5, 

1.0u.uOir.*15 

«  d  •  d  .  JblJ 

RAM 

1  '4 

6.  93147'jE*  3, 

3.4b57i5c.*l» 

6.9314 7. F- 2, 

4. 62. so. E-3, 

RANI 

175 

6.  9314  705*  3» 

6.93147.E+1, 

4.62.9  ?  C5-1, 

1. 38b294t-l , 

PAMl 

176 

6.  418  J28E-5, 

^.310-,9dt~4, 

9.627u  42  6-  5, 

2.5o721lE-4, 

RAMI 

177 

C«.GudCJ  * 

6.93147  j£  +  l , 

4.62-.?  8  d  6  - 1 , 

1. 5  40  3  2  7£-l  , 

PAMl 

1  7 1 

2.31J  49  IE-4, 

2.567211E-3 , 

1. 38b2 946-1, 

G.OdOuu.  , 

RAMI 

179 

4.62  3  9t9E- 1 , 

2.  31  j*»9jc-1  , 

<*.  0  7  73  2  5  6-  2, 

4.2736656-3  , 

PAMl 

led 

172 


$ 

1.216C47E-3, 

6.  416  028E-4, 

5,7762256-3, 

3,2  749  .14  6-8, 

J.O.bO'lL  / 

pami 

lol 

CflTA  ir'CON  II)  *  I=Jcl,475)/ 

P  ami 

lo2 

6.  93147CE*i, 

3.  4657256-1* 

1. 1 55245E-1 , 

9. 6270  426-4, 

1.3 96294E-2 , 

PA  Ml 

183 

Oaijoc^r  t 

6. 931470E+1, 

4 . 62  0  98  «t -1  , 

1.7326  676-1, 

6.9314726-2  » 

PAMI 

la4 

3. 726597E-3, 

2.31048CE-2, 

6.73580  IE -1C 

,  7.121142E-6 

l  •  J  3  j  j  j  3  t 

PAMI 

135 

* 

4.62098TE-1, 

2.31U490E-  1. 

1.7328676-2, 

1.54.327E-2, 

0.00)230  , 

h  AMI 

186 

2.  783723E-3, 

2.3651  61E-6, 

0.00  3  3  30  , 

6.9314706*1, 

2. 77258 St -1  , 

PAMI 

197 

7. 7J1633E-2, 

1.925408^-2, 

6.93147l)t.-2, 

6 • ^ ibu  28  t-  6  f 

C.817671E-4, 

PAMI 

183 

a.oooom  . 

6.  9  31  4  70E  ♦  1, 

3.465735E-1, 

6  .9  3 14  7C  E-  2  , 

3. 4b5  735E-2  , 

PAMI 

189 

o.oioooo  , 

5.5011676-4, 

8.3665306-3, 

1.337C  856-7, 

J«Uj3juC  t 

PAMI 

190 

3. 465735E-1, 

1. 386294E- 1. 

*♦.620  9506-2  , 

1.1929746-3, 

6.534611E-7, 

PAMI 

191 

8.  135001E-9, 

1.3831S6E-7, 

0.  33  0  300  , 

6.9314706*1, 

2.  31J49CE-1, 

PAMI 

182 

9. 9 ) 21 0  OE-2 , 

1.  3 96 22 5E -13. 

6.0802376-4,  6.4lc02PE-7 

t  U*u3J033  t 

PAMI 

193 

6.  9314  71EA1, 

4. 620  98 OE  -  1* 

2.310 49 OE-1, 

2. 7  5C5  936-3, 

8. 5573706-5, 

PAMI 

lb4 

2.  061465E-6, 
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$ 

0. ooooco 

9 

0.000000  • 

O.JUJOOQ  * 

5.8627  0  0  E-6 , 

0.0000  00 

PAMi 

318 

$ 

0.000000 

9 

0*0000(30 

0. 030000  , 

O.CQCOOO  , 

0.000000 

PAMi 

319 

$ 

0. 000003 

9 

C.QOOlOu  , 

o.ooaooo  , 

3.00C-0G  , 

0.00-000 

PAMI 

320 

$ 

0.  0  00  0  00 

9 

4.226C00E-8, 

0.300030  , 

0.0 000 oc  , 

0.0000  JO 

PAMI 

321 

3 

0. 000000 

9 

7.370CD0E-7, 

0.000000  , 

1.2510  JOE-6, 

0.0  .0000 

PAMi 

322 

$ 

0. oooooo 

9 

O.JOOCOO  , 

o.ooaooo  , 

7.7500  COE-6, 

0.0  000  00 

PAMI 

323 

$ 

0. 000300 

9 

C. o  00  COO  , 

O.OuOOOO  , 

J. 000000  , 

0.0000  JO 

PAMi 

324 

s 

i.  7icnaoE-5, 

o.cooaoo  , 

J. 300000  , 

D.OOuiiOG  , 

0.0  JGOuO 

PAMI 

325 

s 

0. 030300 

9 

u.uOJCCQ  , 

0.  300  000  , 

c.ocgooo  , 

o.o  ogojo 

PAMi 

326 

$ 

3. QOOJ-O 

9 

1. 892300E-E, 

0 . JO  0  0  j  j  , 

0.000000  , 

0.0  OUQOO 

PAMI 

327 

$ 

3. 03003C 

9 

O.CGOOOC  , 

0.000030  , 

G.OGCUJC  , 

0.0  CdJOG 

PAMI 

328 

$ 

0. 300000 

9 

C.3O3J00  , 

0.300003  , 

u.CGuJCC  , 

1.063076E-5 

PAMI 

329 

i 

0. 000300 

9 

G.000  COO  , 

0.300000  , 

O.OGoOJl  , 

6 • 4  058  0  OE-6 

PAMI 

330 

$ 

3.  003303 

9 

0 .  C  00  COO  , 

J .0-0000  , 

u.OGoCOC  , 

Q.OOUOOC 

PAMI 

331 

s 

0.  3  303  OJ 

9 

0*000000  , 

O.OwOOOO  • 

O.COlJOC  , 

0.0-0000 

PAMI 

332 

t 

0 .  3  3  0  J  0  C 

9 

0.000000  , 

8.626750E-6, 

C.OoLOuO  , 

0.0  GOCuO 

PAMI 

333 

$ 

0*  3  300  Cu 

« 

Q.viOQtlQD  , 

O.OJOOOO  , 

O.OOCuOO  , 

0.0  CuOJC 

PAMI 

334 

$ 

0.  3  3  0  3  3  '’ 

9 

4.546CG JE-6, 

U.OOUGQJ  , 

C.DUL'OGC  , 

Q.UoOOwO 

PAMi 

335 

s 

0. 030303 

/ 

PAMI 

336 

DATA  <(FOGRNY(I,J)  ,1=1, 7), J 

=14,18)/ 

PAMI 

337 

$ 

0  .  0  3  r  3  0  3 

9 

5. <*938  (QE-7, 

0.030030  , 

j.cotcac  , 

O.QujJOG 

PAMI 

338 

$ 

0. 030000 

9 

0.0  00  COO  , 

0.003300  , 

6.62G0 JOE-6, 

C.OuOOjG 

PAMI 

33  9 

$ 

3.  0"G3  00 

9 

U.wOJ'JOO  • 

G.JuOOJO  , 

u.OOTlijL  , 

1.575J JCE-7 

PAMI 

340 

s 

0  .  0  -1 0  0  3  o 

9 

3.DCCC00  , 

U.OOOOOO  , 

J  •  0  G  o  u  1  L  , 

O.OoOOJC 

PAMI 

341 

s 

0. J  300  00 

9 

0. coo  coo  , 

0.000000  , 

G.  CO  CO  3  0  , 

0.0  u J  0  0  0 

PAMI 

342 

$ 

0. OOCO  03 

9 

C.uOOCOO  , 

0.300033  , 

J.COCuOo  , 

3 .0  CO  Ouu 

PAMI 

343 

$ 

3. 300300 

9 

a. coocoo  , 

J  .  3 a  3  0 QO  , 

Q.GOuuOG  , 

0.0  00000 

/ 

PAMi 

344 

DATA  ( ( XLA  M 

(I,  J)  ,1  =  1,7), J 

=1,13  )/ 

PAMi 

345 

S 

7.  4183  66E 

-9, 

7.46124E-35, 

6.93003E-31, 

1. 7436  59E-7 , 

o .  oo  oo on 

PAMI 

346 

$ 

0. 3  00  3  J  1 

O.oOOCOO  , 

3.487319E-8, 

6.93000E-31, 

6 . 9  3  J  0  0 1-31 

PAMi 

347 

s 

6.930  J3E- 

31, 

6.930C0E-31, 

1. 369444E-5 , 

3.206  3  33E-3, 

6.93C0 -E-3J 

PAMI 

348 

$ 

6.  9303.3E- 

31, 

7.  34  7  328E- 5, 

0 •  10  3  0 J  0  , 

C.COUuOu  , 

O.QuOOCu 

PAMI 

349 

s 

0.  JCOO  CJ 

1.  6892  39E-17, 

6.93 JJOE-31 

,  1. 552  419E-5 

,  -.  000  000 

,PAM1 

350 

2 

0.  3  300  33 

0*000(300  , 

0.330000  , 

5.0  217  39E-3, 

0.0 J0J30 

PAMI 

351 

s 

a.  3ooo c j 

0.3CQGCG  , 

0.  30  0000  , 

O.GOvOOU  , 

Q.JuJJJO 

PAMi 

352 

$ 

1.  2S3333E 

-5, 

0. OOuOOO  , 

0  * J0Q0G3  , 

J.OUuOOO  , 

Q.OOOJOG 

PAMI 

353 

$ 

0.  3 0  0 3  CO 

o*  nooooo  , 

6.930  3  3  c  -  3 1 » 

6.93CC  OE-31, 

6.93JU-E-31 

PAMI 

354 

$ 

6.  930- OE- 

31, 

1. 991379E-3, 

0.30 3 C JO  , 

j.GOLjOL  , 

6.93 JJOE-31 

PAMI 

355 

$ 

1.  77J955E 

-9, 

0. 0  03  300  , 

0.30  0  0  30  , 

J.OGGl’OC  , 

0.000000 

PA  HI 

356 

$ 

0.  330303 

6.930  COE- 31, 

6.930 J0E-31y 

5.276864E-8, 

1.3588  24E- 3 

PAMi 

357 

$ 

0  .  J  J  0  0  C  3 

Q.GOClOO  , 

J.JGOOOO  • 

V.12V6  2CE-14 

,  3.-8J000E- 

4 

,  PAMI 

358 

2 

0  •  J  i  0  Q  0  3 

3  .  3  3  0  COO  , 

0 . 30  0  300  , 

3  c  g  o  e  o  a  a  , 

O.C-OQ-G 

y 

PAMi 

359 

S 

2.  1052Q8E 

-8, 

6.  93GLGE-31, 

6.93JG0E-3J  , 

6.93CUJE-31, 

6. 93  0 -06-31 

PAMI 

360 

•! 

5 


* 

'■ 


i 

t 


175 


■'iy  ri  mm<*t 


iW^iMiii'iTi.MnwrMr  ■fill 


$ 

4. 095745E-6, 

4.8125006-4, 

7.4612406-5, 

O.OOlOOO 

f 

U.Q  GGQGG 

V 

PA  Hi 

361 

$ 

0.  J  ^00  0*3  , 

0.000003  , 

0.300030  , 

C.0QCU3Q 

f 

1.28333E 

-34, 

PA  til 

362 

$ 

6.9303CE-31, 

1.21578 9E-  0, 

0.300000  , 

0.000000 

t 

0.000300 

t 

PAHi 

363 

2 

0.  0000  03  /' 

PAMi 

364 

OATA  < ( XLA M 

(I.J)  ,1=1,7 ),J 

=14,18)/ 

PAHI 

365 

$ 

6.930C:.E-  31, 

2.  310  CQuE<  1, 

0.  0 0  0  0 0 u  , 

3.00.000 

, 

0. 0  JJC33 

, 

PAHI 

366 

$ 

0-000003  , 

o.ccoooc  , 

6.930CJ6-31, 

3.  C718  08E-3, 

O.OGQQUC 

, 

PAMI 

367 

$ 

o.nooco  , 

0.000030  , 

O.OUOOJO  , 

0. OOtO  3o 

, 

2.8  6  5192E-7 , 

PAHI 

368 

f 

6,9703  2£- 31, 

6.930  CCE-31, 

3, 2G3333E-3, 

0 . 0  0  C  0  3  0 

, 

o.ouooao 

i 

PAHI 

369 

$ 

o-  aooF*'*o  , 

5.608974E-7, 

0.300000  , 

0. 0  010  oc 

, 

O.OOQOCC 

, 

PAHI 

370 

2 

0,1300  03  , 

J.COOCOO  , 

0.033000  , 

6.5310  OE 

-31, 

0.000000 

, 

PAHI 

371 

S 

0.31U101  , 

Q.  u  00  0  00  , 

0 •  30  0  030  , 

j. r00C  00 

, 

3.0  00000 

/ 

PAHI 

372 

OATA.  AL8FOM/ 

1 «  6999  99E*  3  / 

PAMI 

373 

DATA  (JRrt  (I), 1=1, 95  )/ 

PAMI 

3  74 

$ 

4, 

5, 

11, 

12, 

17, 

PAHi 

3  75 

$ 

18, 

25, 

26, 

33, 

39  , 

PAHi 

376 

$ 

40, 

41, 

47, 

48, 

49, 

PAMI 

377 

s 

56, 

70, 

78  , 

84, 

85  , 

P  4  Hi 

378 

* 

06, 

37, 

93, 

IOC, 

101, 

PAHi 

379 

* 

1  36, 

109, 

115, 

122, 

123, 

PAMI 

380 

$ 

128, 

129, 

136, 

145, 

146 , 

PAMI 

381 

V 

147, 

153, 

154, 

160, 

161  , 

PAMi 

382 

$ 

163, 

169, 

176, 

177, 

178, 

PAMI 

383 

3 

136, 

192, 

193, 

194, 

2u  9 » 

PAHI 

384 

$ 

210, 

218, 

224, 

22  5, 

232  , 

PAMI 

3o5 

$ 

2  4C  * 

241, 

2  49, 

250, 

257  , 

PAMI 

386 

£ 

258, 

259, 

267, 

268, 

274, 

PAMi 

387 

$ 

276, 

283, 

2o4 , 

291, 

2  93, 

PAMI 

388 

$ 

294, 

295, 

308, 

33  9, 

310, 

PAMi 

389 

$ 

311, 

31  7 , 

316, 

341, 

342  , 

PAMi 

390 

$ 

343, 

350, 

357, 

359, 

360  , 

PAMI 

391 

f 

361, 

369, 

377  , 

37  8, 

379  , 

PAMI 

392 

£ 

384, 

392, 

401, 

40  2, 

408/ 

PAMI 

393 

DATA  (JRM  • 

11.1=96,185  )/ 

PAMI 

394 

t 

409, 

410, 

419, 

42  4, 

425, 

PAMI 

3  95 

j 

426, 

42  7, 

434, 

440, 

441  , 

PAMI 

396 

$ 

4 '*2, 

443, 

447  , 

448, 

451  , 

PAMI 

3  97 

$ 

456, 

457, 

458  , 

46  0, 

468, 

PAMI 

358 

$ 

473, 

474, 

475, 

476, 

477, 

PAMI 

399 

$ 

48  3, 

484, 

489, 

490  , 

491  , 

PAMI 

4.0 

3 

49  ?-. 

49., 

4  96  , 

499, 

5ui, 

PAMI 

401 

3 

50  2, 

50  7, 

508  , 

509, 

51  , 

PAMI 

4  112 

S 

516, 

523, 

528  , 

529  , 

535  , 

PAMI 

4.3 

3 

536, 

53  7, 

542, 

543, 

544, 

PAMI 

4-4 

j 

5  49, 

550, 

551, 

556, 

557  , 

PAMI 

40  5 

J 

563, 

564, 

571 , 

572, 

578, 

PAMI 

40  6 

> 

579, 

585, 

586, 

593, 

6C2, 

PAMI 

4  -  7 

3 

6t  8, 

60  9, 

616, 

621, 

622, 

PAMI 

4  0  8 

! 

629, 

631, 

632  , 

e*e. 

639  , 

PAMI 

6  09 

i 

6*»  6 , 

652, 

653, 

659, 

S65  , 

PAMI 

410 

j 

670, 

671, 

6  77, 

66  4, 

6  90  , 

PAMI 

Mil 

* 

6  31, 

c  t 

C  , 

0, 

0/ 

PAMI 

412 

9  AT  A  (ISO  (11.1=1,16  !/ 

PAMI 

413 

( 

4, 

u  • 

c , 

0. 

0  , 

PAMI 

414 

*  t 

0  , 

u  , 

r. , 

PAMI 

415 

< 

0, 

4  9 

W  9 

fc  , 

j  , 

PAMI 

<.16 

: 

.  • 

*  « 

0  / 

PAMI 

<•17 

it  i  (v.cl  :c  « i  > ,  ;=  i  ,cs  i/ 

p  Af*l 

-.18 

S 

-  »*  rk 

9t7l  ». 

9671J1  2t  , 

56  *16, 

96  7 1  <5v .6-980  . 

PA-1 

<•  *  9 

i 

**■'■*.  *  1  *  2  * , 

.J„ScJ*27l, 

i  e  J  6  j  0  0 

*2  v  . 

j  6  7  fc25  t-  , 

A  M  1 

$  9806C247IJ8,  980  6319  620 

$  9939718148,  993968C292 

$  13073673732,  10w73935876 
$  10374722308,  10074980356 
$  1123  86 778 92,  10208935940 
$  10342371332,  10342633476 
$  13343419908,  10343677956 
$  13477113348,  1C477376514 
$-1061 06  0  678S,  10  611  068932 
$  10612150276,  10612117508 
$  10745548804,  10745610948 
$  13879504386,  10879766532 
$  1C  88  05  529  64,  1088C811012 
$  11314508548,  11C 14 7665 96 
$  11148201988,  11148464132 
$  11149250564,  J1149545476 
$  112829440  04,  1128320614 < 
DATA  (NUCLIO(I) ,1=96,190 
$  11416899588,  11417161732 
$  11417948164,  11418206212 
$  115519C3748,  11552161796 
$-11685335044,  11685597188 
$  11686645764,  11686903  612 
$  118  2  03632  26,  11820601348 
$  11954294788,  11954573858 
$-11955638276,  11955601412 
$  12089n  368  04,  12089298948 
$-12222730244,  12222992386 
$  12224073732,  12224043964 
$  12357472260,  12357734404 
$-12491165700,  12491427844 
$  12492476420,  12492739586 
$  12625907716,  12626169860 
$-12759863300,  12760125444 
$  12761175042,  12761468932 
$  12694343172,  12894605316 
$-12895653892,  12895911940 
DATA  <NUCLID«I) ,1=151,285 


98C  62  327  56 
9940242436 
10 J74198020 
- lu  20  7 8914o0 
-102Q92321CU 
10342896642 
-  16476226916 
1047767C4U4 
10611331076 
1U61 2375556 
10746073092 
1088  3028676 
-11013722116 
-11315632836 
11148727256 
11149508612 
11283468292 

/ 

114174238  76 
-11551117316 
-115524608 u4 
11685859332 
-1181955277 2 
11820363492 
11954819076 
-12088253372 
12189561092 
12223254532 
122242990 12 
12357996546 
12491689988 
12493033476 
126264320  u4 
127  €13375t6 
12761436164 
12894867460 
-13028560960 
/ 


$ 

1 302 "3  473  32, 

1302961C498, 

1302  393  4388  , 

1  30  291  71620. 

130  30129668  , 

PAMI 

459 

$- 

13162  *  78628, 

13163C4U  772, 

13163302916, 

131635 65C60, 

131 £3831300  , 

PAMI 

460 

$- 

13164126212, 

13164069348, 

131  6434 73  8)6, 

-132972  58  500, 

13297520644  , 

PAMI 

461 

13297782788, 

13298044932, 

12298307076, 

132965  7C  242, 

13290864132  , 

PAMI 

4  c2 

$ 

132986  31364, 

13299089412,- 

13431733372, 

134320  1C  516, 

1 34322  626 6J  , 

PAMi 

463 

$ 

13432524804, 

13432782852,- 

13433149092, 

1  34333  07140, 

-13565956100 , 

PAMI 

4  64 

s 

13566218244, 

1356646038  6, 

I35667i,2532  , 

13567u  04676, 

135672668 20  , 

PAMI 

465 

% 

13567524868, 

-13700173828, 

13700435972, 

1  37  0  u6  98 11 6, 

137 0 J960260 , 

PAMI 

466 

$ 

13701223426, 

13  70  1521  412, 

1370 1,84548  , 

137 01742696, 

-1383465  37 uO  , 

PAMI 

467 

$ 

13834915844, 

13  335177988, 

1383544  1132, 

13835702276, 

13835965442, 

PrtMi 

46  8 

$ 

1 J8  362  59332, 

13  8  3  6  22248  8 , - 

13908  371426  , 

139651 33572, 

139693  95716 v 

p  ah;. 

469 

$ 

13969657863, 

1 396  5520004, 

1397Q178u52, 

-139714  77060, 

1  39  70  444292  , 

PA  Ml 

we 

9 

139?37C2340, 

-141C3C89156, 

1410  335  13  uC  , 

1, 10  2b 1 24,4, 

141 j3976538  , 

P  A  M  l 

vl 

$ 

1*134137732, 

1410  4400898, 

1410  *,6947 88  , 

1 410,6 62121, 

l4iJ,92iC63« 

7  A  Ml 

,  /  2 

$- 

14237316984, 

14?3756Q026, 

1423  76J1172  , 

l,23tJ9331t, 

1,2  38  3  554  60  v 

P  A  **  1 

473 

3 

14238621711, 

-14238916612, 

1,23 897,748, 

1,2391  3  7  79t, 

-l4i 71766756, 

PAM£ 

4  74 

i 

1 ,  J  7  2  ’  43900. 

14  3  7  i. 1  1C  4  4, 

14  «  7257  32  tb  , 

14 2728 36*54, 

1,3  73 1 3u24,  , 

PAMI 

475 

i 

14  57  5-47476, 

14373 *69620, 

1,3  7361  7606  , 

-  1 , 5  C  b.  1  4  13  4  , 

146-0266628. 

>-  Ami 

476 

$ 

14516 521772, 

145t6  7  6r916, 

1,5C'7153joC, 

1, 5  0  73  1*  20  4, 

1,5.7373252  / 

PAMI 

*•  /  7 

•> 

AT  A  IMUU.  I P  <  I  >  ,  I  -  2«f,  36  C  )  / 

*  A  !*1 

,7; 

J- 

1  *'.4 '2  ’2  212, 

1 4*  o  4 f43  4c. 

1  ,  •>,  J  t  t  ■ 

1 , 6  4  i  £  J  6  1  —  4 , 

l,fc,lc7ifll  . 

1  AM  1 

, 

1 

1  4<  4’,  1  8? 

7 **;/*. 

. , 6 1 89 <0 6, 

-•■  3 

-993S1 63860 
994C5  00  484 
13074460164 
102081 53604 
1 Q  2  094  6C226 
10343191554 
10476586166 
10477637636 
10611593220 
-10745u  24516 
107463  2114  C 
1C88C2  51842 
110 13S  84260 
11015290834 
111490  22210 
-11282419  716 
112837  26344 


114176 
115513 
115524 
1168  61 
118198 
116  211 
119550 
120885 
120898 
122235 
•123569 
123562 
124919 

12  4929 
126266 
127606 
127616 
126  9  51 

1 3  C  268 


eti.2  c 
7S46u 
28  036 
46594 
14916 
21540 
31220 
12516 
23236 
16676 
4797  2 
5669  2 
52132 
9661  2 
94148 
45732 
94212 
25  60  4 
23C44 


9939456004, 
•100  73411568  , 
100  74755076, 
102 J6415748, 
•10342109166, 
lii  3  431  5  77 64 , 
lu', 7685120  4 , 
10477895664, 
10611855364, 
107 45266660 , 
•10679242244, 
I088Q  565732  , 

110  1 42  4640  4  , 
-111479  2  5844 , 

111  46983420  , 
11282661660  , 

•11416637444/ 

11417981954, 
11551641604, 
11552686064. 
116  66383620  , 
116200  773  60  , 
-119  540  32644, 

119  55347460  , 

120  88799778, 
12  0  90  0  3120 4 v 
12223779842 , 
123572 1G116 , 
12358516740 , 
12492214276, 

-?26256h5572  , 
12626952196, 
lc7 60911876 , 
-12894001028 , 
1<  895367652  , 
130  290  85188/ 


PAM1 
PAMI 
PAM1 
PAM  1 
P  AMI 
PAMt 
PAM1 
PAM  1 
P  AMI 
PAMi 
PAMi 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 
PAMI 


sfcsss 


asa: 


- 14  774  7 020  8  A* 

14  77600870  fit  • 
H.909969410, 
14910750724,- 

15  04444  62 6J, 
15178141700, 
15179186180,- 
153126  8371  8, 
15446839300, 
15  447  £2573  2, 
15  580  794  884, 

-15714750468, 

15718055169, 


$  146420  53124, 

$  14775750660, 
f  14939706244, 

%  14910492676, 

$  15044186116, 
t  151778  79556, 

$  15 1V892 81 32, 

$  15312621572, 

$  15446577156, 

S  15447666692, 
$-15530532740, 

$  15581639364, 

$  157156C33  66, 

$  15716618244, 

$  15850016772, 
$-15983448068, 

$  15984496644, 

DATA  (NUCLIDt 
$-161179279  40, 

$  16119234564, 

$  16253235204, 

$-163866255  40, 

$-163879690  28, 

$  16521368578, 

$  16522149892, 

$  16656105476, 
$-16730540868, 

$  16  7905  90466, 

$  16924282884, 

$-17-3579  763  24, 

?  170590259  22, 

I  17192718340, 
$-17193767458, 

$  17327461378, 

$  17 3282 42692, -17 460 ”91652, 
S  17461678084,  17461936132, 


147749642  26  , 
14908919612, 
14910264322, 
•15043399684, 
150  Wi  Jmj4, 
15176  40  36  44 , 
•15311835140, 
15313145660, 
15447102466, 
15447921666, 
15581557028, 
15715012612, 
15716CS1188 , 


15 716561 380 ,-153 49 23-3  40  , 
1585086 30 12, -159505779 2 4, 
15983710212,  15963972356, 
159847  ‘2769,  15984?58/88, 
I) , 1=361,4751/ 
i.6118 1900  8  4,  16118452228  , 
-16252145668,  3.62524078  12, 
16253196340, -162 534932 52, 
16386987684,  1638714982B, 
16387540896,  16388194308, 
16521670860,  16521633796, 
-16655060958,  16655323140, 
-16656445444,-16656408560, 
167698  C3012,  16793066178, 


16790884356, 
16924545028, 
17 Q5  62  3846  t, 
17059  320834, 
1719  2  9  6150  6, 


16790847492, 
16924d40962 , 
17058501634, 
1 7  0  59  26  70  44  , 
17 193279492 , 


171943 24 56 4, -17326673924, 
1722  7  7  56293 ,  173277225*0, 
17461153796, 
174622J2372, 
$  17595371524,  17595623666,  17595696034, 
OAT  A  JNUCLIOill, 1  =  476, 570)/ 


14775226372,  14775486516,  PAMi  4o 1 
14905181956,  14939444100,  PAnl  462 
?  49 102  *1 554,  1 4910  525444 ,  PAMI  463 
15U43661626,  150  43923972  ,  PAMI  484 
150449  68452,-151  77617412,  PAMI  4o5 
151786  6558  8,  15178961922  ,  PAMI  486 
15212097284,  15312359428,  PAMI  467 
153134 J29J6, -15446315012,  PAMI  4e8 
15447397569,  15447364610,  PAMI  4o9 
15447687676,  15446145924,  PAMI  s90 
15531319172,  15531581316,  PAMI  451 
157152  74756,  1671553  6900,  PAMI  492 
1 57 163  5  ?  76 1,  15716327428,  PAMI  493 
158  49'->  9  2  484  ,  1  3849754628,  PAMI  494 
15850541060,  15850799108,  PAMI  495 
15984235522,  15984533503,  PAMI  496 
1598  5C  5370C,  15965816836/  PAMI  h97 

PAMI  498 

16116714372,  16118976516,  PAMI  499 
16252669956,  16252933122,  PAMI  D*'Q 
162534  56388,  16253714436  ,  PAMI  5*1 
163  6  74 11 9/2 ,  lb38767C020,  PAMI  5J2 
■1652C8 42268,  16521105412,  PAMI  503 
■16521928  /06,  16521091844,  PAMI  504 
16655535234,  1665584  7428,  PAMI  5J5 
•1665 b3 71716,  16656629764,  PAMI  5*6 
16790364164,  16790327300,  PAMI  507 
•16923758596,  16924020740,  PAMI  508 
169248  07172,  169250b5220  ,  PAMI  509 
17058799620,  170  58762756,  F AMI  510 
17056545092,-17152456196,  PAMI  511 
17193242628,  171935*0676,  PAMI  512 
17 3269  36068,  1732 719 8212  ,  PAMI  513 
17327938740,-17328279556,  PAMi  514 
1746x416962,  17461714948,  PAMI  515 
17462460420, -175951J9360 ,  PAMI  5l6 
17596191746,  17596157956/  PAMI  517 

PAMI  518 


$ 

17596421122, 

17596715012, 

17596678148, 

-17729327 

138, 

17729566252  , 

PAMI 

519 

s 

17729851396, 

17770  113540  , 

17730375684  , 

1773,637 

82  8, 

177308958/6  , 

PAMI 

520 

$ 

-1?  3638T6983, 

17864*69124, 

17864332290, 

17864627202, 

1 78  b4  593412  , 

PAMI 

52.1. 

$ 

17864856578, 

17865150468, 

i/865117700, 

175653  75 

748, 

-17998J247C8, 

PAMI 

522 

$ 

17998286852, 

17998548596, 

17  998811140  , 

179990  73 

264, 

179  59  331332  , 

PAMI 

523 

$ 

-17999630340, 

179995975 72, 

17  999855620  , 

-16 1325  J 4 

58  0  , 

18132  766724, 

PAMI 

524 

s 

181330  23868  , 

18133292034, 

18133535924  , 

18 133553 

156, 

181333153*0 , 

r-  a  mi 

525 

$ 

191340  73348, 

-18266984452, 

10267246596  , 

lc 2 6 75 98 

741  , 

1  82  b  7  7667  88  , 

PAMi 

526 

5 

-182680  333  28, 

1826825107  5,- 

13401202190, 

lb  40  14  64 

32n, 

164*1/4 33 64, 

P  AMI 

5 17 

$ 

18401989612, 

16492251778, 

lc  40  2  545666  , 

lo 4C25  0  8 

M4, 

-1853541990  8, 

PAMI 

528 

$ 

185156620  52, 

18535965218, 

185  362?  b3  4t  , 

185364  £6 

48  4, 

1853672  £532, 

PAMi 

529 

s 

-13536992772, 

18537250820, - 

1966 96957 cu  , 

18  676182 

946, 

1  66  7  J  42406*  , 

PAMI 

5*0 

$ 

18670686212, 

18  670948356, 

l9o? 12  164  *4  , 

-186041 17 

5oe« 

10934376652, 

KAMI 

5  31 

s 

13804641796, 

1J33490394Q, 

io3*5l66*  c*.  , 

18  ■*  0  64  2  4 

22  8, 

1  88*  3666276  , 

PAMI 

522 

$ 

-199385«739a, 

18933859524, 

18939121668  , 

1853*38* 

/lx. 

lc9396*595fc. 

F  AMI 

5  3  3 

s 

1893991813C, 

18940 1(61 48,- 

193726101*6 « 

19*7  30  7  S 

252 , 

19)/ 3:  3  9396. 

P  4-1 

524 

i 

1907360x940, 

19373863684, 

1907412  17  32  , 

-  1  J 2 C  70  22 

bit. 

1623  7^^4960 . 

*  AMI 

535 

z 

19  20  755U  24, 

192:7819268, 

i 9 2 '*  o  *5  *  <  lc  , 

: ,  2 tie  *  4 3 

65  6, 

1  92  3  86*5780  « 

PAMI 

536 

% 

192:986374*, 

-193415  127C  8, 

1^34 1 77x8  52  , 

1934<!3  3£ 

596, 

1434229614*/ 

PAMI 

637 

MATA  ISUCLIOC 

X  1*1*571, 665  »  / 

PA-  i 

5  3* 

c 

19 $42561294, 

19 J42e;3426, 

141432314  76  , 

'1447*7  3C 

436. 

1  *4/449256;  , 

PAP.1 

539 

t 

1 1476254/24, 

1947 1616868, 

1,4 76»/,C  17  , 

IW/v  ,! 

156, 

1,4777962x4. 

PA  4  1 

6  •»  t 

...  Hi.  ^ 


■Mi1 


non  rjoonoo  ooOog  ooo 


S- 19 60  99  48164,  19  610  21030  8,  19610472452 
$  19611258884,  19611516932,-19744428036 
$  19745214468,  19745476612,  19745738756 
$-1987  8645764,  198765C7908,  19879170052 
$  19879952388,-19880218628,  19380476676 
$  20013649924,  20013912068,  20314174212 
$-20147343364,  20147605506,  20147367652 


$-20147343364,  20147605506, 
$-20148654084,  20148912132, 
$  20282609666,  20282871(12, 
$  2041630310  I,  204165  65252, 
$-2041 7647650,-20417618466, 
$  20550782980,  205510*5124, 
$-20684738564,  20685000708, 
$-20666049284,  2C686307332, 
$  23819742724,  20820004868, 
$  20953693308,  20953960452, 
$-2108765389  2,  21087916036, 


20 14891 21 32, -20281823236 
20282871  (12,  20263133S56 


20416827396 

20417871876 

20551307268 

20685262852 


$-20684738564,  20685000708,  20685262852 
$-20666049284,  20 68 6307332, -20318956292 
$  23819742724,  20820004868,  20820267012 
$  20953693308,  20953960452,  2J954222596 
$-21087653892,  21087916036,  21088178180 
DATA  (NUCLIOm,  1=666,  7001/ 

$  21098960516,-21221871620,  21222133764 
$  21222920196,  21 22 3 1 78244, -2135635 1492 
$  21357137924,  21357400068,  21357656116 
$  21491093508,  2149135565 2,  21491613730 
$-2l6247o6948,  216250*9092,  21625311236 
$  21626097668,  21626355716,  0 

$  0 ,  0 ,  0 
OATA  (MULT  (I), 1*1, 11  )/ 

$  8,  64,  512 


512 

16777216 


*  262144,  2097152,  16777216 

$  858993459  2/ 

DATA  IBRA,INUC,KRM,  LPAX,  MAXNUC/ 

$  128,  S92,  181 

Q  ****»##«.**«*  **¥**¥*♦♦***##¥**♦¥*  *+++  +  *+**■  +  * 

C 

13  FORMAT ( A6) 

14  FORMAT {  (5E14.6I  I 

SEARCH  FOR  KINO  OF  FISSION  TO  USE 
DO  300  1=1,12 

IF  <FISSIO,EQ.TYPE< I))  GO  TO  305 
OO  CONTINUE 

FISSION  TYPE  REQUESTED  IS  NOT  IN  TABLE 

WRITE  (KOUT,6CiJO)  FISSIO 
6CJQ  FORMAT ( 1H3,  1 7HFISSICN  DATA  FOR  A6 ,  30 
ieiE) 

CALL  ERROR ( 6H  PA  PI  ,-6300,  ISOUT) 

TYPE  FISSION  REQUESTED  FCUNJ  IN  TABLES 
LOAD  THIS  OATA  INTO  ABEGN 


3C5  CONTINUE 


LOAD  TAPE  OAT*  FOP  PCQUESTEO  FISSION 


19610996740  , 
19744952324, 
19746256948  , 
19679694340, 
200133677  60  , 
20014694404, 
20146367644, 
23282347524, 
-20416040964, 
204173475  68, 
20550520636, 
205  51827460  , 
20665763044, 
2U8194 80560  , 
-209534361  64, 
20954742768, 
21066702466/ 

212226580 52  , 
21356875760, 
21490831364 , 
21492137968, 
21625835524, 
0, 
0/ 

32768, 
1073741824  , 


DP  3  '6 

-EATUNfP.lJI  NAH« 


,  1961073*596,  19610996740  ,  PAM1 
,  19744690180,  19744952324,  PAM1 
,  19746000500,  19746256946,  PAM1 
,  19879422196,  1987969434(3,  PAM1 
,-200131 25 (36,  20013387760,  PAM1 
,  20014436356*  20014694404,  PAM1 
,  201 461  25  19 6,  20146387844,  PAM1 
,  20282085380,  20282347524,  PAM1 
,  2028 33 92104,-204 16  0 40964 ,  PAM1 
,  204170  85540,  204173475  68,  PAM1 
,-205502  56692,  20550520836,  PAM1 
,  205515  65412,  20551827460  ,  PAM1 
,  20685524996,  20665763044,  PAM1 
,  20615216436,  2o619480560,  PAM1 
,  208205  25060,-209  53436164,  PAM1 
,  20954464740,  20954742786,  PAM1 
,  210  864  40  324,  21068702468/  PAM1 

PAM1 

,  21222395908,  21222658052  ,  PAM1 
,  21356613636,  21356875760,  PAM1 
,-21494569220,  2149J831364,  PAH1 
,-21491675940,  21492137968,  PAM1 
,  21625572380,  21625835524,  PAM1 
,  0,  0,  PA  Ml 

,  0,  0/  PAM1 

PAM1 

,  4G96,  32768,  PAM1 

,  134217728,  10  73741824  ,  PAM1 

PAM1 
P  AMI 

,  18,  700/  PA Ml 

*««****»»*****»*#¥*#*»«**#*» pa  HI 

PAM1 
PA  Ml 
PA  Ml 
PA  Ml 
PAM1 
PA  Ml 
PAM1 
PAM1 
PAM1 
PA  Ml 

--PRINT  ERROR  PAMI 

PAM1 

PAMI 

H  TYPE  FISSION  IS  NOT  AVAI L APAM1 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

PAMI 

IYFI  IMC  A6EGN  PAMi 

PAMI 

PAMI 

PAMi 


IF  C  EOF  C INT  P)  .NE.  J.C)  GO  TO  307 

PAM1 

601 

REA  0  C INTP, 1 4)  CA5EGNCJ) , J=l,692> 

PAM1 

602 

IF (NAME  .EQ.  FISSIO)  GO  TO  308 

PAM1 

603 

3C6 

CONTINUE 

PAM1 

604 

307 

CONTINUE 

PAM1 

605 

WRITECKOUT.6C01I  FISSIO 

PAM1 

6:6 

6C01 

FORMATC  1HC,  8H  FISSIC=A6,  18H  NOT  FOUNC  IN  FILE) 

PA  Ml 

65  7 

CALL  E  RROR  C6H  PAM1  ,-6001,  ISOUT) 

PAM1 

606 

306 

REWIND  INTP 

PA  Ml 

659 

HSCL=H08/TM**C. 3333 3333 

PAM1 

610 

IF  CEMITN.LE.C.O  )  GC  TO  101 

PAM1 

611 

C 

PAM1 

612 

r. 

CONVERT  H08  FROM  METERS  TG  FEET. 

PAM1 

613 

c 

P  AMI 

614 

HO3=H08*3. 28C64 

PA  Ml 

615 

HSCL=HSCL*3. 26064 

PAM1 

616 

IF  CHSCL.LT. 36.0  GC  TO  27 4 

PAM1 

617 

AL3FOM= J .0 

PAM1 

618 

GO  TO  287 

PA  Ml 

619 

274 

IF  CHSCD276,  277,275 

P  AM  1 

620 

275 

FOM= 1 ,-HSCL/SQRT (4, 24*HSCL*HSCL -  234. *HSCL+ 4225 . > 

PAM1 

621 

GO  TO  286 

PAM1 

622 

27  6 

IF  CHSCL.LT. -2. Cl  GO  TO  278 

PA  Ml 

623 

277 

FOM*1.0 

PAM1 

624 

GO  TO  286 

PAM1 

625 

£76 

AL9F0M  =  1.E4 

PA  Ml 

626 

GO  TO  287 

PAM1 

627 

286 

AL3F0M  =  ALBFOM*FCM 

PAMi 

628 

267 

AL8F0M  =  A  LBFOM*  EMI TN 

PAM1 

629 

GO  TO  101 

PAMI 

630 

100 

LMAX=  1 

PAMI 

631 

101 

CONTINUE 

PAMI 

632 

CALL  FRATIO 

PAMi 

633 

1 

CSLOTMP  , T MS 0  , MCHN  ) 

PAMI 

634 

RETURN 

PAMI 

635 

cNO 

PAMI 

636 

ooooooooooooooooo 


*  DECK, PAM2  PAH2 

SUBROUTINE  PAM2  PAM2 

PAM2 

R  C  TOMPKINS  —  US  ARMY  NUCLEAR  DEFtNSE  LAPS  PAN? 

EXECUTIVE  PROGRAM  FOR  THE  TIME-DEPENDENT  PART  OF  THE  P  ARTICLE  PA  M2 

OCTOBER  1966  PAM2 

ACTIVITY  MODULE  PAM2 

LEO  BY  OPM 2  ANO  PCHECK  PAM? 

PAM2 

*********  GLOSSARY  *♦♦******••  PAM2 

PAM2 

FP(2J0J  ACTIVITY  DENSITY  IN  EACH  PARTICLE  SIZE  FRACTION  PAM? 

ITAB  NUMBER  CF  PAFTICLE  SIZE  CLASSES  PAM? 

MASCHN  MASS  NUMBER  REQUESTED  FOR  OUTPUT  WITH  JGO  -  2  PA  M2 

S V  (20  U )  FRACTION  OF  TOTAL  SURFACE  IN  EACH  PARTICLE  SIZE  CLASS  PAH2 

Cl  VIDEO  BY  FRACTION  CF  TOTAL  VOLUME  PA  M2 

PA  M2 

*****************  ******  FAME 

PA  M? 

COMMON  /OECAY/  I  GO , JC , KDOS , TENT ER ,TEXI T , T IKE  PAM2 

COMMON  /FISHIN/  ABE GN (7 0 0 ) , ABUNDO ( 70 C ) , B RANC h( 13 0» , CAPFI S ,  PAM2 

1  DCON ( 70 0  > ,IBRA,INUC,MAXNUC,MULT(11)*NUCLI0<7 2  D  >  PAM2 

COMMON/ INDUS/ALBFOMf  FAC (7, 18) , FOGRNY ( 7 , 16 ) , ISO (18) »LMAX, XL AM (7, 18) PA  M2 
COMMON  /OUTPUT/  FIS NUM, F F (2 03 ) » FH, IT AB , JGO, h AS  CHS , PS  I ZE (  20 0 1 ,  PAM2 

1  FMASS( 200) ,PACT (200)  PAM2 

COMMON  /UTILTY/  KCUT.NPRNT (15)  PA  M2 

LOGICAL  IGO,JD,KOOS  ,NPRNT  PAM2 

C  PAM2 

100  FORMAT (  ////35X,  E1HTABLE  OF  TOTAL  ACTIVITY  IN  EACH  PARTICLE  SIZE  PA  M2 

1CLASS//  4  (6X ,  5HPSIZE,  1QX,  ZHFP,  5X) )  PAM2 

101  FORMAT (  8(1PE14.4))  PA  M2 

102  FORMAT* 1H03X4QHK  FACTORS  COMPUTEC  FROM  THE  FP  TABLE  -  ,  1PE11.4PAM2 

1 »27X»1PE11.4)  PAM2 

103  FORMAT ( 1H*  ,  55X,  1 6H ( R- M**2 ) / ( HR-KT) ,  22X,  17H (R -MI**2) / (HR-KT ) )  PA  M 2 

104  FORMAT  < 1H  +  ,  55X,  1 1H  (R-M#*  2 ) /KT  *  27X,  12H(R-MI*#2)/KT)  PA  M2 

C  PAM2 

DO  1CI  =  1,200  PAM2 

10  FP  ( I )  =  3.0  PAM2 

C  PA  M2 

GO  TO  (1,2,35 , JGO  PA  M2 

C  PA  M2 

1  CALL  GXPSR  PAM2 

IF  (CAPFISt 3,3,4  PAM2 

4  CALL  URAN  PA  M2 

3  IF  (L  HA X ) 5  ,5,6  PAM? 

6  CALL  IN DC  CZ  PAM2 

6  IF ( NPRNT (15 ) )  RETURN  PAM? 

NTA  8=IT  ABM  PAM? 

IF  (  NT  AB  *•'•>  .LT.  ITAB)  NTAB=NTAB*1  PAM2 

WRITE  (KOUT.IGO)  PAM2 

WRITE  (KOUT.lPi)  (PSIZE(I)  ,FP(i),pSIZE(I*NTAB)  ,FMI*NTAB)  t  PA  M2 

1  PS  I  7E  (  1*2*'  NT  AB )  ,FF(l*2*FTABt  ,PSIZE(  I*J*hTAB)  ,  FF  (J*  3*  NT  A  8)  ,1=1,  PAM2 

2  UTAH)  PA H2 

IF ( JGO  .EQ.  2)  RETURN  PAM2 

CA  YF  4C  =  1«  0  PAM2 

00  7  1=1,1740  P-M2 

7  CAYFAC=CAYFAC»FP(I)  PA m2 

CAYFAC=CAYF  AC  /  FW  PAH2 

CAY  F 4  =C4YF4C* 3. 661 6-7  PA M2 

WRITE  uour.  1C  2)  CAYFAC,C4Y  FA  ‘■’A*? 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 
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36 

37 

38 

39 
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42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 
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54 

55 

56 

57 
46 

4  4 
t(r 


OO  O  O  O  OOOOO 


IF!j!M  WRITE!  KOUT, 1CJ) 

PA  M2 

61 

IF! .NOT .  JO)  WRITE  C  KOUT  ,104) 

PAM2 

ts2 

RETURN 

PAM2 

63 

CALL  MCHOEP 

PAM2 

64 

GO  TO  5 

PAM2 

65 

END 

PAM2 

b6 

•OECK, FRATIO 

SUBROUTINE  FPATIO 
1  (SLOTKP.TMSD.MCHM 

R  C  TOMPKINS  --  US  ARMY  NUCLEAR  DEFENSE  LAPS 
SEPTEMBER  1966 
REVISED  NOVEMBER  1974 

COMMON  /DECAY/  I  GO  ,  JC,K OGS, TENTER, TEXI T , TI ME 
COMMON  /FISHIN/  A8EGN < 7 00 ) , ABUNOOt 7 0 0) , BRANCH! 13 0) ,CAPFI S , 

1  DCON<  700  » , I  BRA, I FUC.MA XNUC, MULT  til > ,NUCLID!70C > 

COMMON  /FRYLNG/  BSU 8K '9 0 ) • ERM < 185) , J Rrt ! 1 85> , XRM , ECF i 90 > 

COMMON  /OUTPUT/  FIS hUM,F f ( 200 ) , F W, IT AB , JGO , HAS CHN, PSIZE ( 2 u Q ) , 

1  FNASS(2Q0) ,PACT (200) 

COMMON  /UTILTY/  KOUI, NPRNT <15) 

LOGICAL  ISO, JD.KOOS , FPRNT 
DIMENSION  FR190) 

DIMENSION  3OIL(40) 

EQUIVALENCE  (FR,BSUBK> 

LOGICAL  NOTO 

DATA  BO  IL/2*  3 1  74 . 0  ,290  7.  C  ,  3  00  J  .  0  ,2976  ♦  i.  ,1764 . 0 , 1  CIO  ,  0,  10  26 . 0 , 351 
1 ,120.1,  1650. 0, 3497.  0,4695.  ik  4808. 0,3 3U 0.0,1351. C, 58 3.0  *4505. G, 41 
2. 0,3 436. 0,2 45 1.0, 1832. 0,2123.0, 2247.  0,1832.0, 153 4.  0,457.4,165.9, 
3  55.  0,30  0  3.  0, 46  08. 0,4  367.  C,  4252. 0 , 446 4. C , 4  346  , P ,  5  *4  30 0 . 0/ 


TIME  -  TMSO 
IGO  =  . FALSE. 

JO  =  .TRUE. 

KOQS  =  .FALSE, 

MAXCHN  =  90 
OO  30  I  =  1, MAXCHN 
30  FR(I>  =  0.0 

CALL  BATMAN 

MCHM  =  0 
RFRC  =  0.0 
CHN  s  0.0 

LAST  =  I ABS (NUCL ID ( 1  )> /MULT <91 
NOTO  =  oFALSE. 

OO  10  MB  =  1,1 NUC 

NAME  =  IA9SHNUCL  ID ! Mg) ) /MUL T ! 6 ) 

MASS  *  NAN£/MUIT<*» 

NAT  =  MCO*NAHF,MULT 


FRATI  1 
FRATI  2 
FRATI  3 
FRATI  4 
FRATI  5 
FRATI  6 
FRAT  t  7 
FRATI  6 
FRATI  9 
FRATI  1C 
FRATI  11 
FRATI  12 
FRATI  13 
FRATI  14 
FRATI  15 
FRATI  16 
FRATI  17 
FRATI  16 
FRATI  19 
FRATI  20 
FRATI  21 
FRATI  22 
FRATI  23 
, 8FR ATI  24 
49FRATI  25 
15 FRATI  26 
FRATI  27 
FRATI  28 
FRATI  29 
FRATI  30 
FRATI  31 
FRATI  32 
FRATI  33 
FRATI  34 
FRATI  35 
F*ATI  36 
FRATI  37 
FRATI  38 
FRATI  39 
FRATI  40 
FRATI  41 
FRATI  42 
FRATI  -.3 
FRATI  44 
FRATI  ,6 
FRATI  46 
FRATI  47 
FRA!  I  4 6 
FRATI  49 


r 4  M 


IF  (NAT.GE.27.AN0.NAT.LE.66)  GO  TO  1 
WRITE  ( KOUT  ,513 )  NAT, HASS 
ABUNO  -  U.O 
GO  TO  10 

i  IF  (MASS.EQ.LAST)GO  TO  3 
MCHN  =  MCHN  ♦  1 
IF  (NOTO)  FR(MCHN)  =  RFRC/CHN 
RFRC  =  0.0 
CHN  =  0.0 
NOTO  =  .FALSE. 

3  ABUNO  =  A8UNDO (MB) 

LAST  =  MASS 

IF  (ABUNO)  10,10,  <« 

4  NOTO  =  .TRUE. 

IF  (BOIL(NAT-26) .GE. SLOT HP)  RFRC  =  RFRC  4-  ABUNO 
CHN  =  CHN  ♦  ABUND 
10  CONTINUE 

MCHN  =  MCHN  4  1 
IF  (NOTO)  FR(MCHN)  =  RFRC/CHN 
C 

IF  (NPRNT ( 6 ) )  GO  TO  22 

19  CO  32  L  =  1  ,MCHN 

BSUBK(L)  =  SORT  (FR  ( L  ) )  -  1.0 
POWER  =  BSUBK(L) 

SUM  =  0.0 

00  20  H  =  1 , 1  TAB 

20  SUM  =  SUM  +  FMASS(M) <PSIZE ( H) ** POWER 
32  ECF(L)  =  1 . 0/ SUM 

IF  (NPRNT  (  7  ) )  GO  TO  23 

21  IGQ  -  .TRUE. 

RETURN 

22  WRITE  (KOUT, 501) 

WRITE  (KOUT, 502)  (J,FR(J) »J=1,MCHN) 

GO  TO  19 

23  WRITE  (KOUT, 503) 

WRITE  (KOUT, 502)  (K,6SUBK(K),K= 1 ,  MCHN) 

GO  TO  21 

511  FORMAT  ( 1H1 ,  “OUTPUT  OF  FRATIO"/  5(6X,  4HMCHN,  6X,  2HFR,  3X)) 
FORMAT  (  5  C7X  »  12,  1PE12.4)) 

F0RMAT(///5(6X,4HMCHK,4X  ,5H BSUBK »2X , ) // > 

513  FORMAT  (44H090ILING  FOINT  IS  NOT  AVAILABLE  FOR  ELEMENT  13, 

1  6H(MAS5  1 3 ,  j. H ) ) 

END 


FR AT  I  50 
FRATI  51 
FRATI  52 
FRATI  53 
FRATI  54 
FRATI  55 
FRATI  56 
FRATI  57 
FRATI  56 
FRATI  59 
FRATI  60 
FRATI  61 
FRATI  62 
FRATI  63 
FRATI  64 
FRATI  65 
FRATI  66 
FRATI  67 
FRATI  66 
FRATI  69 
FRATI  70 
FRATI  71 
FRATI  72 
FRATI  73 
FRATI  74 
FRATI  75 
FRATI  76 
FRATI  77 
FRATI  78 
FRATI  79 
FRATI  30 
FRATI  81 
FRATI  82 
FRATI  63 
FRATI  84 
FRATI  85 
FRATI  86 
FRATI  87 
FRATI  28 
FRATI  89 
FRATI  90 
FRATI  91 
FRATI  92 


oooooooooo 


‘DECK, NATHAN 

SUBROUTINE  OAT  MAN 
VERSION  1 

R  C  TOMPKINS  --  US  ARMY  NUCLEAR  CEFENSE  LAES 
AUGUST  1966 

REVISED  IV  P  H  JONES  —  FEBRUARY  1969 
THIS  VERSION  REPLACES  SUBROUTINES  InGEN,  dATMAN,  DECAY,  ANO  DOSE  OF 
THE  INITIAL  VERSION  OF  OELFIC 


TABLE  WHILE 

I  GO 
JO 


THE  FUNCTION  OF  THIS  SUBROUTINE  IS  TO  CORPITE  RADIOACTIVE  OECAY 
CHAINS  BY  MEANS  OF  THE  BATEMAN  EQUATION 
CALLEO  BY  FRATIO,  GXPSR,  AND  MCHOEP 

C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


*  *  «  * 

ABEGN (700 ) 

A3  UNDO ( 70  C ) 


9(15) 

C  N  I J ( 68  P  ) 
I8R 

IFIGO 
IF  JO 
IGC 

INFORM  1 11 ) 


JD 

KDOS 

KFJD 
LI H { 1 1 ) 

LSUO 

NUC(ll) 

SBR(ll) 

SC  A (151 

SO  C ( 1 5 ) 

TENTER 

TEXIT 

TIME 


•  *  *  *  GLOSSARY  ********* 

INITIAL  FISSION  PRODUCT  ABUNDANCES  IN  ATOMS/lJUuO 
FISSIONS  {PARALLEL  TO  NUCLIO) 

FISSION  PRODUCT  ABUNDANCES  PER  1«:00  FISSIONS 
ATOMS  AT  TMSC  IN  FRATIO 
OISI NT EGRATICN S/SEC  AT  TIME  (JD  =  1) 

DISINTEGRATIONS  FROM  TENTER  TO  TEXIT 
OR  INFINITY  (J0=2) 

CONTRIBUTION  OF  CNE  SU3CHA I N  TO  ABLNDO 
BATEMAN  COEFFICIENTS  FOR  ONE  SUBCHAIN 
COUNTER  TO  KEEP  PLACE  IN  BRANCHING  RATIO 
SCANNING  NUCLIDE  TABLE 

ASSIGNEC  GOTO  PAnAMETER  LORRES  FOND  I NG  TO 
ASSIGNEC  GOTU  PARAMETER  CORRESPONDING  TO 
(LOGICAL)  TRUE  GIVES  ACTIVITY, 

FALSE  GIVES  ATOMIC  ABUNDANCES 

TABLE  OF  DAUGHTER  RETRIEVAL  INFORMATION  FOR  EACH 
MEMBER  CF  A  SUQCHAIN,  OBTAINED  BY  TRUNCATING  NUCLIO 
FROM  THE  LEFT 

COMPUTES  EXPOSURE  RATE, 

DOSE 

COMPUTES  DOSE  FROM  TENTER  TO  TEXIT, 
OOSE  F  TOM  TtNTER  TO  INFINITY 


(LOGICAL)  TRUE 
FALSE  COMPUTES 
(LOGICAL)  TRUE 
FALSE  COMPUTES 
SEE  IF  JO 
SUBCHAIN  TABLE 
BRANCHING  PATH 

COUNTER  FOR  SUBCHAIN  MEMBERS 
CROSS  REFERENCE  OF  SUBCHAIN  MEMBERS 
SUBCHAIN  BRANCHING  RATIOS 
FISSION  YIELCS  OF  SUBCHAIN  MEMBERS 
DISINTEGRATION  CONSTANTS  OF  SUBCHAIN  MEMBERS 
ENTRY  TIME  (SEC)  FOR  OO^t  CALCULATION  WITH  JO 
EXIT  TIME  (SEC)  FOR  COSE  CALCULATION 
WITH  JO  =  FALSE,  KUOS  =  TRUE 

TIME  (SEC)  AT  WHICH  EXPOSURE  KATE  CR  MASS  CHAIN 
GE  PO  SI  TP  IS  CALCULATED  WITH  JJ  =  TRUE 


OF  INDICES  FCR  MULT  TC  FIND  CURRENT 


TO  INDEX  IN 


/DECAY/  I  GO  ,  JG.KPCS, TENTER, TEXIT, TIME 

/FI  SHIN/  ABEGN ( 70 F)  ,  AB’iNOC  (  70  '  I  ,  3nANCh(  U'.l  .CAPFIS, 


COMMON 
COMMON 

i  ocon(7  :p>  ,ibra,  inuc.maxnuc.nulk  hi  ,ncCLiO(7'‘ : ) 


COMMON 

/uri 

LT  Y  / 

KO 

UT, 

NPPNT ( 15) 

logical 

I  GO 

,  JO  «  K 

OOS 

, NPRNT 

JIMEnSI 

UN 

EP  AC 

( 1 

1  1 

•  KBR 

( 

ID 

l 

, 

INC  OR 

H(  1 

1) 

.LI** 

< 

lit 

2 

• 

5CA 

( 1 

1  1 

i  Do 

4 

1  1* 

,  Nur 


(11  > 


Sti- 


>■( 


— *■  r.  -  ■  .  M 


( i; 


BATMA 
dATMA 
dATMA 
dATMA 
BATMA 
3ATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
8  ATM  A 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
NUCLIDBATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BATMA 
BA  TM A 
BATMA 
BATMA 
BATMA 
dATMA 
dATMA 
BATMA 
BATMA 
dATMA 
dATMA 


=  FALSE 
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2 

3 

4 

5 

6 
7 
6 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 
23 
2  4 
25 
2  6 

27 

28 

29 

30 
i  i 

32 

33 

34 
o5 

36 

37 

38 

39 

4U 

Hi 

42 

43 

44 

45 

46 
h7 

4  6 

49 

50 

51 

52 

5  3 

54 

55 

56 

57 

58 

59 
8C 


o  o  o 


C 

LOGICAL  FLAG 
C 

CC  SET  INITIAL  VALUES 
no  1  I  =  1,INUC 
i  ABUNOom  s  c.o 
I3R  =  0 
C 

CC  8EGIN  MAIN  LOOP  THROUGH  THE  NUCLIDE  TABLE 
C 

10  DO  51 G  IN  =  1 » I N  1C 

C  FINO  THE  NEXT  NUCLIDE  THAT  8EGINS  A  SUBCHAIN 
IF  { NUC LID  < IN) )11»500»499 

SET  PARAMETERS  FOR  BEGINNING  OF  A  JUBUHmIN 
MEMBERSHIP  COUNTER 

11  LSUB  =  1 

C  BRANCHING  RATI C  COUNTER 

LEIR  =  IBR 
KEIR(l)  =  LBR 

C  STARTING  INOEX 

NUC (11  =  IN 

12  LIM(LSUB)  =  4 

C  PROCESS  A  SUBCHAIN  MEMBER 
12  KP  -  NUCaSUB) 

IM  ::  LIMaSUBl 

INFO  =  MOD(IABS(NUCLID(KP)l ,MULT(5)1 
INFORMl LSUB 1  =  INFC 
INC  =  1 

C  SET  UP  SUBCHAIN  DISINTEGRATION  CONSTANTS 
SOC (LSUB)  =  OCON (KP) 

CHECK  FOR  ENO  OF  SUBCHAIN 

IF  (INF0.EQ.4)  GO  TO  21 
CHECK  FOR  BRANCHING 

IF  (MOO(1'NFO,MULT(1)  1.LT.4)  GO  TO  14 
SBR (LSU3)  =1.0 
GO  TO  15 

C  SET  UP  SUBCK,»IN  BRANCHING  RATIOS 

14  LB  =  LBR  *  5  -  IM 

SBR (LSUB)  =  BRANCH(LB) 

C  EXTRACT  THE  OAUGHTER  INCREMENT 

15  ID  =  MOD ( I NFO. MULT (IM+1) )/MULT (IM) 

C  SEE  IF  THIS  INCREMENT  SHOULD  BE  NEGATIVE 

IF  (MOO(INFO,MULT(2)  )/MULT  (  1 )  .  EQ  .  I M)  GO  TO  16 
C  SET  PARAMETER  TO  LOOK  AHEAO  FOR  BRANCHING  RATIO  CF  OAUGHTER 
KI  =  Kp 
GO  TO  17 

C  SET  PARAMETER  TO  LOOK  BEH I  NO  FOR  BRANCHING  RATIO  CF  OAUGHTER 
1  (  KI  =  1 
LBR  =  0 
INC  =  -INC 

COMPUTE  OAUGHTER  INDEX 
17  NOAUT  =  KP  ♦  INC* 1 0 
KOA  =  NOAUT  -  1 

C  STEP  THROUGH  THF  NUCLIDE  TABLE  TO  cSTABLISH  THE  CORRECT  INOEX  FOR 
C  THE  BRANCHING  RATIO  CF  TMf  OAUGHTER 
00  2C  K  =  KI.KOA 

2?  LBR  =  LBm.  ♦  4  -  IA0S  INOO  (NUCLI  JiK)  .HUL  1  (  if.  )  ) 


BATMA  61 
BATMA  62 
BATMA  63 
BATMA  64 
BATMA  65 
BATMA  66 
BATMA  67 
BATMA  68 
BATMA  69 
BATMA  70 
BATMA  71 
BATMA  72 
BATMA  73 
BATMA  74 
BATMA  75 
BATMA  76 
BATMA  77 
BATMA  78 
BATMA  79 
BATMA  80 
BATMA  81 
BATMA  62 
BATMA  83 
BATMA  84 
BATMA  85 
BATMA  86 
BATMA  87 
BATMA  88 
BATMA  89 
BATMA  90 
BATMA  91 
BATMA  92 
BATMA  93 
BATMA  94 
BATMA  -ib 
BATMA  96 
BATMA  97 
BATMA  98 
BaTMA  59 
BA  THAI  JO 
B  A  T  M  A  1 1!  1 
BATMAIlC 
BATHA1.3 
BATHAit 4 
BA  TM A  1 ^5 
BATMA 1 J6 
BATMA1  ’  7 
BATMA;.  J6 
9ATMA1J9 
BATMAUQ 
BATMAUi 
BATMA)..* 
BATMAl',3 
3ATHA114 
BATMm 1 15 
3ATNAU6 
3A  TMA 1 1  7 
.(4T  Mm  lit1 


XBR  (  ISU  9  ♦  1 1 


LBR 


uOLBit— .-Ml 


II  (.  U'. 


-f£L. 


BATMmUO 

bATMUt’t' 


C  ACCEPT  THE  DAUGHTER  FOR  MEMBERSHIP  IN  THE  SUBCHAIN  AND  RECYCLE 
LSUB  =  LSUB  ♦  1 
IF  <LSUB.GT.li>  GO  TC  1301 
NUC ( LSUB)  =  NDAUT 
GO  TO  12 
C 

CC  A  SUBCHAIN  HAS  NON  BEEN  SET  UP  AMO  CAN  BE  STUDIED  IN  TOTO 
C  ELIMINATE  UNI-NEH8ERE0  SUeCHAIN 

21  IF  (LSUB.EQ.l)  GO  TO  500 

C  RUN  3ACK  THROUGH  THE  SUBCHAIN  TO  ACCUMULATE  BRANCHING  RATIOS 
ASSIGN  23  TO  LGO 
JL  =  0 

SCA (LSUB)  =  1.6 
LAST  =  LSUB  «•  1 
00  22  L  =  2, LSUB 
LBACK  =  LAST  -  L 
SCA(LBACK)  =  1.0 
GO  TO  LGO, <22, 23) 

C  FIND  THE  LAST  BRANCH  IN  THU  SUBCHAIN 

23  IM  a  LI M (L BACK ) 

IF  (MOO (INFORM  (LBACK) , MULT  < IM) >/MULT (IM-1))  22,  22,24 

24  JL  =  LBACK 
ASSIGN  2?  TO  LGO 

22  SCA(LBACK)  =  SBR  ( LO A CK)  ♦  SCA  ( L8ACKU ) 

SCA  (I, SUB)  =  Q.G 

CORRECT  FISSION  YIELDS  FOR  BRANCHING 
FLAG  =  .FAuSE. 

DO  25  J  1  ,LSUB 
JN  =  NUC(J) 

SCA(J)  =  SCA(J)*ABEGMJN) 

IF  (FLAG)  GO  TO  25 

C  MAKE  A  NOTE  IF  A'i  ..EAST  ONE  VALUE  CF  SCA  IS  NONTRIVIAL 
IF  (SCA  (J))  25,25,27 
27  FLAG  =  .TRUE. 

25  CONTINUE 
C 

C  CM  IT  COMPUTATIONS  FOR  TRIVIAL  SUBCHAIN 
IF  (.NOT. FLAG)  GO  TC  3C 
C 

CC  THE  CENTRAL  COMPUTATIONS  BEGIN  AT  THIS  PCINT 
C 

DO  200  N=i , LSUB 

IF(JO)  TENTER=TI ME 

EFAC(N) =  £XP (-SOC (N) *  TENTER) 

IF(KOOS)  EFAC(N)  =  E  F  AC  <  N)  -  EXP  <  -  SOC  <  M)  '  TE  X I T ) 

R-J.  0 

DO  163  K1=1,N 
CNI J=i  ,  0 
0=2.0 

DO  162  K=1 , N 
K2-N-M  1 

IF(K?.NE.N)  CNIJ=CN t J*SOC (K2I 
IF(K2,EQ.K1)  GO  TO  162 
FACTC=SOC(K2)-SOC(Kl) 

I(-  <  A)S1  FACTC).  lT.1.  E-15)  F  ACT  C=  S  1GN(  1.  t-  15  -  F  AC  TC  ) 

CNI  J*CNIJ/F  ACTC 

162  IF(lf2.LE.Kl)0  =  Q*CN:  J*SCA  «2  ) 

IF  (JO)  GO  TC  153 
IF(S1C( <i> «Ll. j. :•  GC  TC 
Q«1/SOC  <«C1) 

L'4) 


BATMA121 

BATMA122 

BATMA123 

BATHA124 

BATMA125 

BATMA126 

BATMA127 

BATMA128 

6ATMA129 

BATMA130 

BATMA131 

BATMA132 

BATMA133 

BATMA134 

BATMA135 

B ATM Ai 36 

BATMA137 

BATMA136 

BATMA139 

BATMA140 

BATMA141 

BATKA142 

BATMA143 

BATMA144 

BATMA14E 

BA 7 MAI 4 6 

BATH A 147 

6ATMA148 

BATM A1h9 

BATMA150 

BATHAiSl 

BATH A152 

CA  IMA153 

BATH Al 54 

GATMA155 

BAi MA156 

BATMA157 

3ATMA158 

BATMA159 

BATMA160 

BATMA161 

BATMA162 

BATMA163 

8ATM Ai£4 

3ATMA1E5 

BATMA1E6 

BATMA1E7 

BATMA16B 

BATMA169 

BATHA170 

B  ATNAl 71 

BATMA172 

94TMA17 3 

BATMA174 

BATMA175 

BATMAl/b 

BA  THAI  7 7 

BmTHAI 78 

BA THAI  79 

BATH  Al*0 


LLV i •  iaI  •  j  «  n) w  -.1  0.0! J  liX*. 


O  O  O  o 


163  8=3»Q*EFAC(K1> 

IFC8.Lc.:.C»  GO  TO  £00 
IF(IGO)  3=B*SDCCNI 
NK=NUC( Ml 

ABUNOO(NK) = ABUNOO ( NK ) >3 
200  CONTINUE 
C 

C  SET  UP  A  NEW  SUBCHAIN  STARTING  PROP  DEEPEST  UNEX  FLORED  BRANCH 

30  IF  (  IL)53IJt499,31 

31  LSUS  *  JL 

LIM<LSU8I  =  LlMJLSUei  -  1 
L3R  =  «BRU.SUB) 

GO  TO  13 
C 
C 

1301  WRITE  IKOUT.1351)  NUCLIQ(IN) 

C 

C  STEP  UP  BRANCH  COUNTER  IN  MAIN  LOOP 

49  <3  1BR  -•  I8R  +  4  -  HOC  SIABS  1NUCL ID  (IN)  )  ,  MULT  (1)  > 

500  CONTINUE 

IF  (NPRNT  (9 ) )  WRITE  (KOUT,  1000)  (NUCLlOdl  »A6UND0(  I)  »I*1  ,INUC> 
RETURN 

15  0  0  FORMAT  (17H10UTPUT  OF  BATMAN//6  X6HNUCL IQ11X6HA  BLNDO/ 

1  (5X012»5XlPE12.4s) 

1351  FORMAT  ( 25H  0SU8CH A I h  BEGINNING  WITH  D12.8H  TOO  BIG) 

FNO 


BATMAldl 
BATMA182 
BATH  *183 
BATMA184 
BATHA185 
BATMA136 
BATH A187 
BATMA188 
3ATMA189 
BATMA190 
BATMA191 
BATMA192 
BATMA193 
BATMA194 
BATMA195 
BATMA196 
BATH A197 
BATH  A196 
BATMA199 
BATMA200 
BATMA201 
BATMA202 
BATMA2J3 
BATMA2u  4 
BATMA205 
BATMA206 


♦DECK,  GXPSR 

SUBROUTINE  GXPSR 

CASSIDY  -  NROL  /  TCFFKINS  -  NOL 


CALLED 


NOVEMBER  1965 
I  BY  PAM  2 

COMMON  /DECAY/  I  GO  ,  JC,K DOS, TENTER , TEXI T , TI M E 
COMMON  /FISHIN/  A8 E GN ( 7 0 0 ) , ABUNOO ( 7 00 ) » BRANCH< 13 0 ) , CAPFI S , 
QCON(7j3> ,IBRA,INUC,Ma XNUC , MULT < 11 ) , NUCLI D <7  u 0 ) 

COMMON  /FRY  LNG/  BSU 6 K ( 90  )  , ERM C 1 8 5 ) , JRM < 185)  , KRM , ECF ( 90 ) 

COMMON  /OUTPUT/  F  IS  MM,  F  F<  200)  ,  FW,  IT  Ad  ,  JGO  ,  MAS  CNN  ,  PSI 2E  <  20  3  ) , 

.  FMASS<  200  .PACT  (20  0) 

COMMON  /UTILTY/  KO U T, NPRNT C 15) 

LOGICAL  IGOtJD.KDOS, NPRNT 

DIMENSION  XRT ( 90 ) 

n*TA  CROSS, UNIT/1.  It-4, 1.0/ 

FORMAT 

L  (16H10UTPUT  UF  GXPSR/ 5 X 1 3HP ART IC LE  SI ZE 7X2 4HFI SSI  ON  PRODUCT 
!  T  I V  I T  V  ) 

FORMAT 

L  (8X7 M  MfIERS16XllH(R*M**2)/MR/# ) 

FORMAT 

L  <5*ipE12.>».l4XE  U.o) 

f PPRAT 

,  MX  7“  MEIERS  If  ctHW»H»*2//* 


GXPSR  1 
GXPSR  2 
GXPSR  3 
GXPSR  4 
GXPSR  5 
GXPSR  6 
GXPSR  7 
GXPSR  8 
GXPSR  9 
GXPSR  10 
GXPSR  11 
GXPSR  12 
GXPSR  13 
GXPSR  14 
GXPSR  15 
GXPSR  16 
GXPSR  17 
GXPSR  18 
GXPSR  19 
GXPSR  20 
GXPSR  21 
ACGXPSR  22 
GXPSR  23 
GXPSR  24 
GXPSR  25 
GXPSR  26 
GXPSR  27 
GXPSR  26 
GXPSR  29 


m 


’fjgyifliflffifH'm  '.'■.'lame 


^szr 


11 

COMPUT 

C 

12 

C 

C 


21 


40 

20 


C 

C 


10  1 
102 


103 


CALL  BATMAN 
MAXMCH  =  90 
MCH  =  0 

00  1  I  =  1, MAXMCH 
XRT(I)  =  0.0 

00  1]  J  =  1,K*M 
K  =  JRM (J) 

IF  (ERM { J) )  11,10  ,12 
MCH  =  MCH  +  1 

E  MASS  CHAIN  NORMALIZATION  FACTOR 
X RT (MCH)  =  XRT  (MCH)  ♦  A8LNU0(K)*A3S(ERK(J)) 


10  CONTINUE 


DO  20  LC  =  1, MCH 
IF  (XRT (LC) )2C,2G,21 
BN"X  =  8SUBK (LC ) 

CRISS  =  CROSS**BNEX 

RAOIAL  =  ECF(LC  ) /(UNIT  CkISS  *ECF  (LC)  ) 
STRAIT  =  RAOIAL*CRISS 
TNEX  =  FIS  NUM*  XRT ( LC ) 

00  40  LO  =  1 , 1  TA  B 

FP(LO)  =  FP(LD)  ♦  ( KAOIAL*PSIZE (LO) **BNEX 
CONTINUE 


IF  (. NOT.NPRNT (1C) )  RETURN 


WRITE  (KOUT.9C1) 

IF  (JO)  GO  TO  101 
WRIT17  (KOUT.912) 

GO  TO  102 
WRITE  (K0UT.9C2) 

CONTINUE 

DO  1 J  3  1=1,  IT  At) 

WRITE  (KQUT,9C3)  F'SIZE(I)  ,FP(I) 
CONTINUE 

RETURN 

ENO 


GXPSR  30 
GXPSR  31 
GXPSR  32 
GXPSR  33 
GXPSR  34 
GXPSR  35 
GXPSR  36 
GXPSR  37 
GXPSR  38 
GXPSR  39 
GXPSR  40 
GXPSR  41 
GXPSR  42 
GXPSR  43 
GXPSR  44 
GXPSR  45 
GXPSR  4b 
GXPSR  47 
GXPSR  48 
GXPSR  49 
GXPSR  50 
GXPSR  51 
GXPSR  52 
GXPSR  53 
GXPSR  54 

ST RA1T)*TNEX+FMASS(LD) GXPSR  55 

GXPSR  56 
GXPSR  57 
GXPSR  56 
GXPSR  59 
GXPSR  60 
GXPSR  61 
GXPSR  62 
GXPSR  63 
GXPSR  64 
GXPSR  65 
GXPSR  66 
GXPSR  67 
GXPSR  68 
GXPSR  69 
GXPSR  70 
GXPSR  71 
GXPSR  72 


*9ECK,URAN 

SUBROUTINE  URAN 
C 

C  R  C  TOMPKINS  -  US  A?  MY  NUCLEAR  DEFENSE  LABS 

C  MAT  19 06 

CALLED  BY  PAM2 
C 

C  OLAM  DISINTEGRATION  CONSTANT  OF  NP233 

C  PLAN  DISINTEGRATION  CONSTANT  OF  U233 

r% 

COMMON  /CECAY/  IGO,  JO  ,  RODS ,  T  ENT  ER  »  TEX  IT,,  TIH* 

COMMON  /FISHIN/  A3EGN  ( 700)  »  A9UN  DO  <  70  0  )  , BRAND  H  (1 3  II  ♦  C  APF  IS, 

1  OGON<7(iC),  I8RA,INJC,MAXNUC,  NULT(il)  ,NUCLID  (7C0  ) 

COMMON  /OUTPUT/  F ISNUM,  F  P<  2  J  ] ) ,  F  W*  I T  AB,  JGO,  M  ASCH  N>  PS  I ZE  <?£> )  >  * 
1  FrtASS(2u0>, PACTC200) 

COMMON  /UTILTY/  KOU  T  ,  NPRN  T  ( 1 51 
LOGICAL  IGO,  JO,  KOOS,  NPRNT 

rs 

J 

PLAM  =  0.693147/(23. 5*6C « 0  I 
COMPUTE  NP23j  DISINTEGRATION  CONSTANT 
COMPUTE  U Z 39  DISINTEGRATION  CONSTANT 
Ol.AM  =  0.693147/(55. 0*3630 ,D> 

C 

2  AZERO  -  CAPFIS' l.E4i' PLAM 
GLMP  =  OLAM/ (OLAM  -  PLAM) 

GLUMP  ••  AZERO*GLM° 

C 

IF  (.NOT. JO)  GO  TO  3 
A  BUR  AN  =  AZERO*  EXP  <  -PLAM*  TIME) 

ABNEP  --  GL MP* ABURAN  -  GLUMP'EX3  { -Dl AM*TIMF) 

GO  TO  7 
C 

3  IF  <  .  NOT  .  KDG  S)  GC  TO  4 

ABURAN  =  A  ZERO/ PLAN*  (EXP  (  -  °L  AM  *  TENT  t  R)  -  EXP  (  -  pL  AM*  TE  X  IT*  > 
ABNEP  =  GLMP* APURAN  - 

1GLUM P* ( EXP  ( -DLAM*TENTEp)  -  EX*  ( -DL AM " TEX  I T ) ) /O LAM 
GO  TO  7 
C 

4  ABURAN  =  AZERO/PLAM*  EXP  < -PLAM* TENTEP) 

C 

ABNEP  =  GL  MP*  A  j  UR AN  -  GLUM P f O LA M*EX P  (-DLAM*TENTER) 

7  ANfP  -  (ABURAN*.  327E-6  *  A 7 N£ P* . 9 66E - 6 ) * F ISNUM 
DO  o  J=  1 ,  I  TA  B 

8  FPlJ)  =  FP  <  J )  ♦  ANE°*  FMASS (  J ) 

C 

IF  ( NPRNT (12) )  WRITE  (KOUT.ljC)  AN£P 
100  FORMAT 

1  (i 3H10UTPUT  OP  JPAN/yKEl (MASS  239  CONTRIBUTE'  i^ElC.A, 

2  239  TO  EACH  PARTICLE  SI7E.) 

RE  TURN 

ENO 


UR  AN 

1 

UR  AN 

2 

UR  AN 

3 

UR  AN 

4 

UR  AN 

5 

UR  AN 

6 

UR  AN 

7 

UR  A  N 

0 

U?  AN 

9 

UR  AN 

1  0 

UR  AN 

11 

U»  AN 

12 

URAN 

13 

UR  AN 

14 

URAN 

15 

URAN 

16 

URAN 

17 

URAN 

1  8 

URAN 

19 

UR  AN 

20 

URAN 

21 

URAN 

22 

U3  AN 

23 

URAN 

2  4 

URAN 

25 

URAN 

26 

U=  AN 

27 

U’AN 

20 

URAN 

29 

URAN 

30 

URAN 

21 

U’AN 

32 

URAN 

7  3 

URAN 

74 

URAN 

75 

URAN 

3  6 

UR  AN 

77 

URAN 

2  8 

U»AN 

39 

URAN 

4  0 

U;  AN 

PI 

u=>an 

P2 

UR  AN 

L3 

URAN 

U 

URAN 

p  5 

U5AN 

P  6 

U3AN 

P  7 

URAN 

p  8 

U’  «N 

P  9 

UR  AN 

«  0 

URAN 

C1 

o  o 


*D 

c 

c 


ECK,INDCD2 

SUBROUTINE  INOCO  2 

NOVEMBER  1966 

COMMON  /DECAY/  IGO,  JD,KOOS,  1  ENTER, TEXIT.TIME 
COMMON/ INDUS/ ALBFOMjF AC (7»191  , FOGRNY ( 7 , 18)  ,  ISO ( 18) »LKAX,XL 
COMMON  /OUTPUT/  FISNUM,  FP(  20  'J ) ,  F  W,  I  TAB ,  JGO,  MASCHN,  PSI  ZE  <20 
1  FMASS(2o0),PACT(20C) 

COMMON  /UTILTY/  OUT  ,NPRNT  (15) 

LOGICAL  IGO,  JD,  KDOS,  NPRNT 

.000  FORMAT 

1  (17  HIOUTPUT  OF  I NDCD2/5  R  53HI NDUCE  D  ACTIVITY  IN  THE  TRA 

2  SOIL  CONTRIBUTES  1PZi2.4,23H  TO  EACH  PARTICLE  SIZE.) 

SORE  =  u.G 

DO  24  L  =  l.LMAX 
IS  =  ISO (L) 

OO  22  I  -  1, IS 
OLAM  =  -XL  AM  (  1,  L  ) 

IF  (  .NOT. JO)  GO  TO  !  2 

ORI  =  -FAC  (I,L)*OLAM*FOGRNY<  I.  L)*EXP(DLAM*TIME> 

GO  TO  22 

12  IF  (  • NOT • K DO S)  GO  TO  14 

ORI  =  F  AC  ( I,  L)  ‘  FOGRNY(I,L)'  <  EX3 ( OLA  M*  TENTE0)  -  EXP  (OLAM*  TE<  IT)) 
GO  TO  22 

14  ORI  =  P  AC  <  I,  U*  FOGRNY  ( I ,  L)  *EXP< OLAM*TENTER> 

22  SORE  -  SDRE  +  OPI 
24  CONTINUE 


SORE  -  SORE* AL9F OM’FISNUM 
OO  2  6  MA  =  1  ,1  TAB 

26  FP(HA)  =  FP(MA)  «■  SO  RE*FMASS  (  MA  ) 

IF  ( NPRNT(ll))  WRITE  (KOUT,10Q3)  SDRE 

RETURN 

END 


INDCD  1 
INOCO  2 
INOCO  3 
INOCD  4 
INOCO  5 
AH  (7,  16)  INOCO  6 
3),  INOCO  7 

INOCO  8 
INOCD  9 
INOCO  10 
INOCO  11 
INDCD  12 
NSPORTEDINOCD  13 
INOCO  14 
INOCO  15 
INOCO  16 
INOCO  17 
INOCO  18 
INOCO  19 
INOCO  20 
INOCD  21 
INOCD  22 
INOCO  23 
INOCO  24 
I'lOCO  2  5 
INOCO  2  6 
INOCO  27 
INOCO  28 
I N  DC  O  2  9 
INOCD  30 
INOCD  21 
INOCO  3  2 
INOCO  3  3 
INOCD  34 
INDCD  35 
INOCO  3  6 
INDCD  37 
INOCO  38 
INOCO  '9 
INOCO  NO 
INOCO  41 
INOCD  42 
INOCO  4  3 
INOCD  4A 
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♦DECK,  rICHOEP 

SU3 ROUTINE  MCHDEP 

R  C  TOMPKINS  -  US  ARMY  NUCLEAR  DEFENSE  LABS 
NOVEMBER  1966 
ALLEO  8Y  PAM2 

COMMON  /OECAY/  I  GO  * J C ,KDOS , TENTER » TEXI T , TIME 

COMMON  /FISHIN/  ABE GN (7 00) , ABu NDC < 70 0 >  , BRANCH < 130 , C APFI S , 

1  OCON ( 700 ) ,IBRA»INUC»MAXNUC»MULT(11)»NUCLID(700) 

COMMON  /FRY LNG/  BSU BK ( 90 ) , ERM < 1 3 5) « JRM < 135) , KRM , ECF ( 90 ) 

COMMON  /OUTPUT/  FISKM,  F  f  C  200»  t  FW,  ITA8  ,  JGO,  MASCHN.PSI  ZE  (  2  0  0 )  , 
1  FM ASS (2001 f PACT (20  J ) 

COMMON  /UTILTY/  KCUT, NFRNI C15) 

LOGICAL  IGQ*JD,K00S* NPRNT 
C 

DIMENSION  FMTA  <  7),FMTB<10) 


1 

COMPUT 


CCFPUT 


LOGICAL  TZERO* THIN LS 

DATA  <FMTA ( I)  «  1=1,6  )  /iaH</14X31H  T,  10HOTAL  ABUNO, 
L  10HSS  CHAIN  I,  10H3,4H  HAS  1,  10HPE12.5.9H  /, 

?  (FMT8(I>  *1=1  »9) /1 0K17H 10UTPU*  10HT  OF  MCHOE,  1CHP 
5  10HARTICLE  SI,  10HZE6X22HACT ,  104IVITY  OF  M,  10HAS 
►  10  H4/9  X6HMETE ,  10HRS18X,  9H  /, 

5  UNITC/  10 HCURIES  />/,  UNITF/  1Q4FISSI0NS/) / 

DATA  CROSS, UNIT/ 1. 0 £-4, 1.0/ 

FORMAT 

L  <5X1PE12.4,14XE12.4) 


TZERO  =  .FALSE. 

TMINUS  =  .FALSE. 

FMT  A (  7)  =  UNITC 
FMTB(IO)  =  UNITC 
IF  (TIME) 11,1,2 
TZERO  =  .TRUE. 

E  EQUIVALENT  FISSIONS 
ABNOM  =  1.0 
FISNUM  =  FISNUM*1.E4 
FMT  A (  7)  =  UNITF 
FMTB(IO)  =  UNITF 
IF  (NPRNTC13I)  HRJ.TF 
IF  (TZERO)  GO  TO  1J 
F  ACTIVITY  IN  CURIES 


10HANCE  OF 


1  GHP/// 5X13HP, 
10HASS  CHA INI , 


(K  OUT  ,  FMT  B)  MASCHN 


MCHOE  1 
MCHOE  2 
MCHOE  3 
MCHOE  4 
MCHOE  5 
MCHOE  6 
MCHOE  7 
MCHDE  8 
MCHOE  0 
MCHDE  10 
MCHDE  11 
MCHOE  12 
MCHDE  13 
MCHOE  14 
MCHDE  15 
MCHOE  16 
MCHOE  17 
MCHOE  18 
MCHOE  19 
MCHOE  20 
MA, MCHOE  21 
MCHOE  22 
MCHOE  23 
MCHDE  24 
MCHDE  25 
MCHOE  26 
MCHDE  27 
MCHOE  28 
MCHDE  29 
MCHDE  30 
MCHOE  31 
MCHDE  32 
MCHDE  33 
MCHOE  34 
MCHDE  35 
MCHDE  36 
MCHOE  37 
MCHDE  38 
MCHDE  39 
MCHDE  40 
MCHOE  41 
MCHDE  42 
MCHDE  43 
MCHDE  44 
MCHDE  45 


CALL  BATMAN 
A  3  N  0  4  =0.0 
DO  220  Kl= 1 »I NUC 

IF ( MASC HN.NE.IABS* NUCLI 0(K1))/MULT<9))  GC  TO  220 
C  SUM  THE  ACTIVITIES  IN  ONE  MASS  CHAIN  AND  CONVERT  TO  CURIES 

A  BN  DM  =  ABNOM  ♦  ABUNCC(Kl) 

220  CONTINUE 

ABNOM  =  ABNOM/3. 7E1 0 
C 

IF  (ABNOM) 9,9, 10 

C  THE  REST  IS  AN  ABRIDGEMENT  OF  GXFSR 
1C  DNEX  =  3SUB:'(MASCHN-71) 

CRISS  =  CRCSS**8N£X 

RADIAL  =  ECF(MASCHN-7l)/(UNIT  +  CRISS*ECF  (  MASC  HW1 )  ) 
STRAIT  =  RADI AL*CRI SS 


MCHDE  46 
MCHDE  47 
MCHOE  48 
MCHOE  49 
MCHOE  50 
MCHOE  51 
MCHOE  52 
MCHDE  53 
MCHDE  54 
MCHDE  55 
MCHDE  56 
MCHDE  57 
MCHOE  58 
MCHOE  59 
MCHOE  60 
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o  o  o  o 


134 


ABNDM  =  A8N0M*FISNUM 
00  134  LD  =  i»  I T A 8 
OSR  =  (  RAQIAL*PSIZ  £  ( LO)  **B  NEX  ♦ 
FPCLO)  =  FP<LD)  +  OSR 
IF  ?  j  NO  T , NPRNT (1 3 )  )  GO  TO  9 
WRITE  ( KOUT *9C  3) 

1  (PSIZE(I)tFP(I)  tI=l»ITA8) 

9  WRITE  (KOUT,FMTA)  MASCHN. A8N0M 
RETURN 


STRAIT) *ABNDM*  FMASS (LO) 


*  * 


nfifF  TNSFRTIGN  POINT  * 


11  TMINUS  =  . TRUE. 

RETURN 

**************** 

END 


*  * 


MCHOE  61 
MCHOE  62 
MCHOE  o3 
MCHOE  64 
MCHDE  65 
MCHOE  66 
MCHOE  67 
MCHOE  68 
MCHOE  69 
MCHOE  70 
MCHCiE  71 
MCHOE  72 
MCHOE  73 
MCHOE  74 
*  MCHOE  75 
MCHOE  76 
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APPENDIX  A 

STRUCTURE  AND  SPECIFICATION  OF  THE  HORIZONTAL  RESOLUTION  NET 
FOR  HORIZONTALLY  NONHOMOGENEOUS  WIND  AND  TURBULENCE  FIELDS 


All  wind  and  turbulence  fields  are  resolved  in  the  vertical  in  terms  of 
strata  in  each  of  which  unique  data  are  specified.  In  most  cases  the  fields 
are  taken  to  be  horizontally  homogeneous,*  but  occasionally  a  situation 
occurs  vnere  it  is  important  to  account  for  variation  with  geographical 
location,  particularly  with  regard  to  the  winds.  Then  it  is  necessary  to 
spatially  resolve  the  wind  field  in  the  horizontal.  In  DELFIC  this  hori¬ 
zontal  resolution  is  identical  in  each  vertical  stratum  so  that  the  remainder 
of  this  discussion  involves  only  the  two  horizontal  dimensions. 

A  rectangular  "control"  net,  oriented  with  its  axes  in  the  west-to-east 
and  south-to-north  directions,  x  and  y  respectively,  with  square  mesh  of 
spacing  WINT,  its  southwest  corner  at  point  (XLLC.YLLC),  and  with  numbers 
ICX  and  JCX  of  mesh  units  in  the  x  and  y  directions  respectively  is  speci¬ 
fied  by  the  user  (DTM  cards  3  and  4).  Figure  A.l  illustrates  a  case  with 
ICX  =  C  and  JCX  =  3. 

Each  one  of  the  control  net  mesh  units  may  be  quartered,  and  each 
quarter  may  be  quartered,  etc.  Information  as  to  whether  or  not  quartering 
occurs  is  contained  in  an  array  NET ( ICX ,JCX) :  if  a  mesh  is  not  quartered, 
a  positive  integer,  which  serves  as  an  index  to  the  data  arrays,  is  con¬ 
tained  in  the  appropriate  NET  entry,  but  if  the  mesh  is  quartered,  NET  con¬ 
tains  a  negative  integer  which  when  set  positive  is  the  index  to  another 
array  NETSU(NCX).  For  each  quartered  control  mesh  or  submesh,  NETSU  contains 


A  horizontally  homogeneous  field  is  one  in  which  the  field  property  may 
vary  with  horizontal  direction  (e.g.  ,  a  vector  field  such  as  a  wind  field) 
but  which  is  constant  along  any  directional  axis. 
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HINT 


Figure  A.l.  Illustration  of  a  horizontal  transport  space  net  with  ICX  =  5,  JCX  =  3  and 
three  levels  of  mesh  quartering. 


four  successive  entries,  each  of  which  contains  a  positive  or  negative  inte¬ 
ger.  A  positive  integer  indicates  that  the  mesh  quarter  is  not  further 
quartered  and  the  integer  serves  as  an  index  to  the-  data  arrays.  A  negative 
integer  indicates  that  the  quarter  is  itself  quartered,  and  when  set  positive 
the  integer  serves  as  an  index  to  the  first  of  another  set  of  four  entries  in 
NETSU,  and  so  on. 

Mesh  quartering  specifications  are  via  DTM  cards  5r  which  are  read  into 
array  KARY(MARX).  Having  already  received  ICX  and  JCX  for  the  control  net, 
the  code  reads  MARY(l)  to  MARY (MARX)  where  MARX  =  ICX*JCX.  Each  entry  is 
for  a  different  control  net  mesh,  and  if  0  it  specifies  quartering,  but  if  1 
it  specifies  no  quartering.  As  many  cards  are  read  as  necessary  to  accommo¬ 
date  the  MARX  entries.  Next,  the  code  reads  MARY(l)  to  MARY(MARK)  where 
MARK  =  4*  (number  of  zeros  found  on  the  preceding  MARY  cards).  These  define 

the  first  subdivision  level  of  mesh  quarters,  and  as  many  cards  are  read  as 

necessary  to  accommodate  the  MARK  entries.  This  process  is  repeated  for  as 
many  additional  levels  of  subdivision  as  necessary. 

Ordering  of  entries  on  the  MARY  cards  is  as  follows.  For  the  control 
net  the  first  MARY  entry  is  for  the  southwest  corner  mesh,  we  then  proceed 
eastward  along  the  bottom  row  to  the  right  boundary,  then  to  the  left-most 
mesh  in  the  row  above,  etc.  The  MARY  cards  for  the  quartered  meshes  are 
filled  by  considering  the  quartered  meshes  in  the  same  sequence  as  their 

zeros  are  found  on  the  preceding  MARY  cards  which  define  them.  Then  for  each 

set  of  quarters  the  entries  are  in  the  sequence 


Figure  A. 2  gives  the  MARY  cards  required 
control  mesh  entries  are  contained  on  card  a, 
card  b,  the  second  on  card  c  and  the  third  on 


by  the  Fig.  A.l  example.  The 
the  first  level  of  quartering  on 
card  d. 
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NUMBER 


required  to  define  the  net  structure  of  Fig.  A.l. 
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APPENDIX  B 

MAP  ORDINATE  THRESHOLDS 


Two  map  ordinate  threshold  values  are  either  specified  by  the  user 
(QCUT  and  CUTMAP,  sec.  2.4  and  sec.  3.3,  card  6)  or  set  by  the  program. 
Here  we  describe  how  the  program  sets  these  values.  The  parameter  QCUT, 
designated  to  >n  in  Vol .  I  sec.  5.2,  is  the  minimum  acceptable  contribution 
from  an  individual  deposit  increment  of  fallout  at  any  point  in  the  map; 
that  is,  any  contribution  at  any  point  less  than  QCUT  is  ignored.  CUTMAP 
is  the  minimum  acceptable  cumulative  value  of  contributions  at  any  map 
point;  that  is,  after  accumulation  of  all  contributions,  any  map  ordinate 
with  value  less  than  CUTMAP  is  set  to  zero. 

On  the  basis  of  experience  we  find  that  for  H  +  1  hour  normalized 
exposure  rate  maps  QCUT  =  10~4  and  CUTMAP  =  1CT2  work  satisfactorily  in 
most  cases.  These  quantities  are  designated  QCUTA  and  CUTMPA  in  the  pro¬ 
gram  (line  30  in  subroutine  0PM2).  The  QCUTA  value  assumes  that  the 
number  of  deposit  increments  of  fallout  is  approximately  in  the  range  500 
to  2500,  and  it  forms  the  basis  of  all  QCUT  evaluations;  thus,  if  many 
fewer  than  500  or  many  more  than  2500  deposit  increments  of  fallout 
are  used,  some  experimentation  with  QCUTA  values  should  be  undertaken. 

For  exposure  rates  at  times  other  than  H  +  1  hour  and  for  integrated 
exposure  (i.e.,  dose)  QCUT  =  QCUTA*  where  <J>  is  as  for  eq.  (4.3.1)  of 
Vol.  I,  and  similarly  for  CUTMAP. 

For  activity  from  an  individual  mass  chain  (NREQ  =  14,  Table  3), 

QCUT  QCUTA*  2.08  x  1013  in  units  of  equivalent  fissions,  and  QCUT  = 
QCUTA*  10~4  in  units  Curies  m-2,  and  similarly  for  CUTMAP. 

For  maps  which  use  deposited  fallout  mass  instead  of  activity 
(NREQ  <  2  and  NREQ  >  10,  Table  3)  QCUT  =  QCUTA*  m  /(7  x  109GWp)  where  m$ 
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is  total  mass  of  debris  and  soil  lofted  by  the  cloud,  G  is  a  combined 
grounded  roughness-survey  instrument  response  correction  factor  (GRUFF), 
and  7  x  IQ9  is  a  rough  average  activity  K  factor  ((Roentgen  -m2)/(hr  -  KT)). 
CUTMAP  is  computed  similarly. 
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ATTN:  DRDAR-LCN-E 

U.S.  Army  Ballistic  Research  Labs. 

ATTN:  DRDAR-VL 
ATTN:  DRDAR-TSB-S 
ATTN:  DRDAR-BLV 

U.S.  Army  Command  &  General  Staff  College 
ATTN:  Combined  Arms  Research  Library 

U.S.  Army  Concepts  Analysis  Agency 
ATTN:  MOCA-WG 

U.S.  Army  Foreign  Science  &  Tech.  Center 
ATTN:  DRXST-SD-1 

U.S.  Army  Mobility  Equip.  R&D  Command 
ATTN:  DRDME-RT,  K.  Oscar 
ATTN:  DRDME-WC,  Technical  Library,  Vault 

U.S.  Army  Nuclear  &  Chemical  Agency 
ATTN:  MON A- ZB,  D,  Panzer 
ATTN:  Library 

U.S.  Army  War  College 
ATTN:  Library 

DEPARTMENT  OF  THE  NAVY 

Center  for  Naval  Analysis 
ATTN :  NAVWAG 

Naval  Academy 

ATTN:  Nimitz  Library/Technical  Rpts.  Branch 

Naval  Postgraduate  School 
ATTN:  Code  56PR 
ATTN:  Code  1424 

Naval  Research  Laboratory 

ATTN:  Code  8440,  F.  Rosenthal 
ATTN:  Code  2627 

Naval  Surface  Weapons  Center 
ATTN:  Code  R14 
ATTN:  Code  U41 
ATTN:  Code  F31 
ATTN:  Code  U12 
ATTN:  Code  F30 
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Naval  Surface  Weapons  Center 


ATTN:  Code  DG-50 


Academy  for  Interscience  Methodology 
ATTN:  N.  Pointer 


Naval  War  College 

ATTN:  Code  E-ll,  Tech.  Service 


Atmospheric  Science  Associates 
ATTN:  H.  Norment 


Naval  Weapons  Evaluation  Facility 
ATTN:  Technical  Director 
ATTN:  G.  Binns 

Office  of  Naval  Research 
ATTN:  Code  431 
ATTN:  Code  200 

DEPARTMENT  OF  THE  AIR  FORCE 

Assistant  Chief  of  Staff 

Studies  &  Analyses 
“■  Department  of  the  Air  Force 
ATTN:  AF/SAGF 
ATTN:  AF/SAMI 
ATTN:  H.  Zwemer 

Air  Force  Weapons  Laboratory 

Air  Force  Systems  Command 
ATTN:  SUL 
ATTN:  NSSB 


66th  MI  Group 

ATTN:  RDA  for  T.  Greene 

BDM  Corp. 

ATTN:  <3.  Braddock 

Decision-Science  Applications,  Inc. 
ATTN:  D.  Puch 

General  Electric  Company— TEMPO 
ATTN:  DAS  I AC 

General  Electric  Company— TEMPO 
ATTN:  DAS  I AC 

Historical  Evaluation  &  Rsch.  Org. 
ATTN :  T .  Oupuy 

Hudson  Irstitute,  Inc. 

ATTN:  H.  Kahn 
ATTN:  C.  Gray 


Ballistic  Missile  Office 
Air  Force  Systems  Command 

ATTN:  MNR,  R.  Landers 

DEPARTMENT  OF  ENERGY  CONTRACTORS 

Lawrence  Livermore  National  Laboratory 
ATTN:  L-24,  G.  Staehle 
ATTN:  L-9,  R.  Barker 
ATTN:  1.-21,  M.  Gustavson 
ATTN:  L-8,  F.  Barrish 

Los  Alamos  National  Scientific  Laboratory 


ATTN: 

R. 

candoval 

ATTN: 

E. 

Chapin 

ATTN: 

R. 

Stolpe 

ATTN : 

W. 

Lyons 

ATTN : 

M/S  632,  T.  Dowler 

JAYCOR 

ATTN:  E.  Almquist 

Kaman  Sciences  Corp. 

ATTN:  V.  Cox 
ATTN:  F.  Shelton 

Kaman  Sciences  Corp. 

ATTN:  T.  Long 

McLean  Research  Center,  Inc.. 
ATTN:  W.  Schilling 

Mission  Research  Corp. 

ATTN:  D.  Sowle 

Pacific-Seirra  Researcn  Corp. 
ATTN:  G.  Lang 


Sandia  National  Laboratories 
Livermore  Laboratory 
ATTN:  T.  Gold 

Sandia  National  Laboratories 
ATTN:  J.  Kaizur 
ATTN:  3141 

OTHER  GOVERNMENT  AGENCIES 


R  &  D  Associates 

ATTN:  R.  Montgomery 
ATTN:  C,  MacDonald 
ATTN:  P.  Haas 

Rand  Corp. 

ATTN:  Library 
ATTN:  T.  Parker 
ATTN:  J.  Digby 


Central  Intelligence  Agency 
ATTN:  OS R/ SEC 
ATTN:  OSR/SE/F,  A.  Rehm 
ATTN:  OSI/NED 

Federal  Emergency  Management  Agency 

ATTN:  Hazard  Eval .  &  Vul .  Red.  Oiv. 
ATTN:  Deputy  Director,  J.  Nocita 
ATTN:  Asst.  Dir.  for  Rsch.,  J.  L'uchar.on 


Santa  Fe  Corp. 

ATTN:  D.  Paolucci 
ATTN:  N.  Pol  mar 
ATTN:  E.  Ortlieb 
ATTN:  M.  Wade 
3  cy  ATTN:  A.  Billones 


U.S.  Arms  Control  &  Disarmament  Agency 
ATTN:  C.  Thorn 
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DEPARTMENT  OF  DEFENSE  CONTRACTORS  (Continued) 


Science  Apol icatiuns ,  Inc. 
ATTN:  M.  Drake 
ATTN:  J.  Martin 
ATTN:  C.  Whittenbury 


System  Planning  Corp. 
ATTN:  F.  Adelman 
ATTN:  0.  Douglas 
ATTN:  G.  Parks 


Science  Applications,  Inc. 
ATTN:  J.  Goldstein 
ATTN:  J.  McGahan 
ATTN:  W.  Layson 
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